home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 November / EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso / earcd / comm / pltdor10.lha / Door227 / PLUTDOOR.LST < prev    next >
File List  |  1995-08-22  |  59KB  |  2,489 lines
  1. ' PlutDoor Point Pickup Door:
  2. '
  3. ' By Peter Deane
  4. '
  5. ' (c) 1992-1995
  6. '
  7. '
  8. testingit!=FALSE
  9. '
  10. MODE 1
  11. ON ERROR GOSUB woops
  12. '
  13. '
  14. versnum$="$VER: PlutDoor 1.00 (22-Aug-95)kyj"
  15. versnum$="1.00"
  16. versdate$="22-Aug-95"
  17. doorname$="PlutDoor"
  18. '
  19. '
  20. DIM ansi$(10)
  21. DIM m68%(15)
  22. DIM m67%(15)
  23. DIM aka$(10)
  24. DIM aka%(10,4)
  25. '
  26. cr$=CHR$(13)+CHR$(10)
  27. de$=CHR$(8)+" "+CHR$(8)
  28. esc$=CHR$(27)
  29. '
  30. timeon%=CINT(TIMER/200)
  31. '
  32. ' Parse command line.
  33. '
  34. problem!=FALSE
  35. cline$=_dosCmd$
  36. '
  37. IF testingit!
  38.   cline$="-uRay Markham -b19200 -t40 -pBBS:Doorfiles1/door227 -s0"
  39. ENDIF
  40. '
  41. IF LEN(cline$)
  42.   '
  43.   IF INSTR(cline$,"-u")=0
  44.     problem!=TRUE
  45.   ELSE
  46.     uu%=INSTR(cline$,"-u")
  47.     ll%=LEN(cline$)
  48.     uname$=RIGHT$(cline$,ll%-2)
  49.     '
  50.     IF INSTR(uname$,"-b")=0
  51.       problem!=TRUE
  52.     ELSE
  53.       bb%=INSTR(uname$,"-b")
  54.       ll%=LEN(uname$)
  55.       baud$=RIGHT$(uname$,(ll%-bb%-1))
  56.       uname$=LEFT$(uname$,bb%-2)
  57.       uname$=TRIM$(uname$)
  58.       '
  59.       IF INSTR(baud$,"-t")=0
  60.         problem!=TRUE
  61.       ELSE
  62.         tt%=INSTR(baud$,"-t")
  63.         ll%=LEN(baud$)
  64.         tpc$=RIGHT$(baud$,ll%-tt%-1)
  65.         baud$=LEFT$(baud$,tt%-2)
  66.         '
  67.         IF INSTR(tpc$,"-p")=0
  68.           problem!=TRUE
  69.         ELSE
  70.           pp%=INSTR(tpc$,"-p")
  71.           ll%=LEN(tpc$)
  72.           '
  73.           path$=RIGHT$(tpc$,ll%-pp%-1)
  74.           tpc$=LEFT$(tpc$,pp%-2)
  75.           '
  76.           IF INSTR(path$,"-s")=0
  77.             problem!=TRUE
  78.           ELSE
  79.             ss%=INSTR(path$,"-s")
  80.             ll%=LEN(path$)
  81.             '
  82.             ring$=RIGHT$(path$,ll%-ss%-1)
  83.             path$=LEFT$(path$,ss%-2)
  84.           ENDIF
  85.           path$=TRIM$(path$)
  86.           IF RIGHT$(path$,1)<>"/" AND RIGHT$(path$,1)<>":"
  87.             path$=path$+"/"
  88.           ENDIF
  89.           '
  90.         ENDIF
  91.       ENDIF
  92.     ENDIF
  93.   ENDIF
  94.   '
  95.   '
  96. ELSE
  97.   problem!=TRUE
  98.   IF EXIST("RAM:Userdata")
  99.     '
  100.     OPEN "I",#2,"Ram:Userdata",1024
  101.     LINE INPUT #2,tpc$      ! Remaining time in minutes
  102.     LINE INPUT #2,uname$    ! User's name
  103.     LINE INPUT #2,id$       ! User number
  104.     LINE INPUT #2,lev$      ! Security of caller (1-9)
  105.     LINE INPUT #2,baud$     ! Baud rate
  106.     LINE INPUT #2,ring$     ! Local (=0) or remote (=1)
  107.     LINE INPUT #2,path$     ! The pathname for the door to use
  108.     CLOSE #2
  109.     problem!=FALSE
  110.     '
  111.   ENDIF
  112.   '
  113. ENDIF
  114. '
  115. '
  116. IF problem!
  117.   '
  118.   PRINT "Error in setting up"
  119.   PRINT
  120.   PRINT "Usage details:"
  121.   PRINT
  122.   PRINT "PlutDoor -u<User Name> -b<Baud> -t<Time> -p<Path> -s<0|1>"
  123.   PRINT
  124.   PRINT "-u<User Name> should NOT be in inverted commas"
  125.   PRINT "-b<Baud>      is the locked modem (DTE) speed"
  126.   PRINT "-t<Time>      is the time remaining for the user"
  127.   PRINT "-p<Path>      is the pathname for config/userdir etc"
  128.   PRINT "-s<0|1>       serial type. -s0 = local, -s1 = remote"
  129.   PRINT
  130.   PRINT "-u, -b, -t, -p, -s are all case-sensitive!"
  131.   PRINT
  132.   PRINT "If the door is run with no command line, a Metro ram:userdata"
  133.   PRINT "file is searched for. If found the door will also run."
  134.   PRINT
  135.   PRINT "This window will close in 10 seconds...."
  136.   DELAY 10
  137.   END
  138. ENDIF
  139. '
  140. ' Real baud rate now dummied to DTE speed.
  141. '
  142. realbaud$=baud$
  143. '
  144. ' Go for more info from the doordata file if it's there
  145. '
  146. IF EXIST("ram:doordata")
  147.   OPEN "I",#2,"ram:doordata",16384
  148.   LINE INPUT #2,temp$
  149.   LINE INPUT #2,realbaud$
  150.   LINE INPUT #2,temp$
  151.   LINE INPUT #2,temp$
  152.   LINE INPUT #2,temp$
  153.   LINE INPUT #2,temp$
  154.   LINE INPUT #2,ansi$
  155.   CLOSE #2
  156.   ansi!=VAL(ansi$)
  157.   askansi!=FALSE
  158. ELSE
  159.   askansi!=TRUE
  160. ENDIF
  161. '
  162. @lowercase(uname$)
  163. uname$=lcase$
  164. '
  165. '
  166. @find.config
  167. '
  168. '
  169. IF config$="XXX"
  170.   PRINT "No config file could be found"
  171.   PRINT "We look in the directory "+path$
  172.   PRINT "for it. Please check that either."
  173.   PRINT "the config exists or the command"
  174.   PRINT "line is correct."
  175.   PRINT
  176.   PRINT "This window will close in 10 seconds...."
  177.   DELAY 10
  178.   END
  179. ENDIF
  180. '
  181. ' First write to log makes sure we've got one, so this'll work
  182. ' under WB 1.3.  All subsequent log writes use APPEND mode, and
  183. ' don't have to do an If Exist() all the time.  Faster logging.
  184. '
  185. IF EXIST(logfile$)
  186.   OPEN "A",#54,logfile$,4096
  187. ELSE
  188.   OPEN "O",#54,logfile$,4096
  189. ENDIF
  190. '
  191. PRINT #54,CHR$(10)+"% ";
  192. @dateconv(DATE$)
  193. PRINT #54,pd.date$;" ";
  194. PRINT #54,TIME$;"  ";
  195. PRINT #54,"PlutDoor V"+versnum$+" opened"
  196. CLOSE #54
  197. '
  198. @log(logfile$,"%","Online user: "+uname$)
  199. '
  200. ' find screen size required from PlutDoor.cfg
  201. '
  202. sw%=VAL(winw$)
  203. sh%=VAL(winh$)
  204. sx%=0
  205. sy%=0
  206. '
  207. ' convert strings to numbers
  208. '
  209. bd%=VAL(baud$)
  210. tpc%=VAL(tpc$)
  211. id%=VAL(id$)
  212. lev%=VAL(lev$)
  213. IF VAL(ring$)
  214.   ring!=TRUE
  215. ELSE
  216.   ring!=FALSE
  217. ENDIF
  218. '
  219. '
  220. scrnht%=23
  221. '
  222. @open_screen
  223. @main_window
  224. '
  225. arplib$="arp.library"+CHR$(0)
  226. arpbase%=OpenLibrary(V:arplib$,0)
  227. '
  228. IF ring!=TRUE
  229.   @open_serial
  230.   PAUSE 24
  231.   @set_baud(bd%)
  232. ENDIF
  233. '
  234. ' ======================================================================
  235. '
  236. ' We're in, hit em hard and good!
  237. '
  238. ' reset terminal
  239. @msend(esc$+"[0;40;37m"+CHR$(12)+cr$)
  240. IF car%>0
  241.   GOTO finish
  242. ENDIF
  243. '
  244. @killkeys
  245. IF askansi!=TRUE
  246.   @checkansi
  247. ENDIF
  248. '
  249. IF car%>0
  250.   GOTO finish
  251. ENDIF
  252. @setansi
  253. abscontin!=FALSE
  254. '
  255. ' ======================================================================
  256. main:
  257. ' ======================================================================
  258. @tchk
  259. IF car%>0
  260.   GOTO finish
  261. ENDIF
  262. '
  263. @banner
  264. IF car%>0
  265.   GOTO finish
  266. ENDIF
  267. '
  268. @msend(CHR$(12))
  269. '
  270. fl$=userdir$+uname$
  271. '
  272. IF NOT EXIST(fl$)
  273.   @log(logfile$,"%","No config setup for this user")
  274.   '
  275.   @msend(ansi$(2)+"To use this door, the sysop has to set you up an account."+cr$)
  276.   @msend("No account for '"+uname$+"' could be found."+cr$+cr$)
  277.   IF car%>0
  278.     GOTO finish
  279.   ENDIF
  280.   '
  281.   @killkeys
  282.   @msend(ansi$(3)+"Do you wish to read more about this door (Y/n)? ")
  283.   @mget(3,1,1,1)
  284.   IF in$="NO" OR car%>0
  285.     GOTO finish
  286.   ENDIF
  287.   @log(logfile$,"%","User asked for more info")
  288.   '
  289.   @msend(CHR$(12)+ansi$(6))
  290.   @seq.out(textdir$+"New_User.txt")
  291.   IF car%>0
  292.     GOTO finish
  293.   ENDIF
  294.   @press
  295.   IF car%>0
  296.     GOTO finish
  297.   ENDIF
  298.   @msend(ansi$(0)+cr$+cr$)
  299.   @killkeys
  300.   @tchk
  301.   IF car%>0
  302.     GOTO finish
  303.   ENDIF
  304.   @msend(ansi$(5)+"Do you wish to download further info (y/N)? ")
  305.   @mget(3,1,0,1)
  306.   IF in$="NO" OR car%>0
  307.     GOTO finish
  308.   ENDIF
  309.   @chooseproto
  310.   IF car%>0
  311.     GOTO finish
  312.   ENDIF
  313.   @log(logfile$,"%","User downloaded more info")
  314.   @xfer(protocol%,"S",textdir$+"New_User.lha",1)
  315.   '
  316.   GOTO finish
  317. ENDIF
  318. '
  319. @find.user
  320. @log(logfile$,"%","User has an account")
  321. @embed_convert(freqhandler$)
  322. freqhandler$=embed$
  323. '
  324. tries%=0
  325. leaveloop!=FALSE
  326. '
  327. DO WHILE tries%<3
  328.   '
  329.   @killkeys
  330.   @msend(cr$+cr$+ansi$(2)+"Enter your mail session password: "+ansi$(1))
  331.   @mget(6,10,0,1)
  332.   IF car%>0
  333.     leaveloop!=TRUE
  334.     tries%=99
  335.   ENDIF
  336.   incoming$=in$
  337.   incoming$=TRIM$(incoming$)
  338.   IF password$<>incoming$
  339.     @msend(cr$+CHR$(7)+ansi$(6)+"Incorrect. You only have three tries!"+cr$)
  340.     IF tries%<2
  341.       @msend(cr$+ansi$(3)+"(this is not necessarily the same as the BBS password)"+cr$)
  342.     ENDIF
  343.     @log(logfile$,"%","User entered wrong password ('"+incoming$+"')")
  344.     INC tries%
  345.   ELSE
  346.     leaveloop!=TRUE
  347.   ENDIF
  348.   '
  349. LOOP UNTIL leaveloop!
  350. '
  351. IF tries%>=3
  352.   '
  353.   @killkeys
  354.   @log(logfile$,"%","User excluded from door!!!")
  355.   @msend(cr$+cr$+ansi$(1)+"You have incorrectly entered the password three times now.")
  356.   @msend(cr$+cr$+"To disable any further fraudulent attempts, your account will be renamed.")
  357.   @msend(cr$+cr$+ansi$(5)+"You must now contact the sysop to access this account!")
  358.   @killkeys
  359.   @press
  360.   '
  361.   IF EXIST(userdir$+uname$)
  362.     IF EXIST(userdir$+uname$+".BadPwd")
  363.       KILL userdir$+uname$+".BadPwd"
  364.     ENDIF
  365.     '
  366.     NAME userdir$+uname$ AS userdir$+uname$+".BadPwd"
  367.     @log(logfile$,"%","Renaming "+userdir$+uname$)
  368.     @log(logfile$,"%","as "+userdir$+uname$+".BadPwd")
  369.     '
  370.   ENDIF
  371.   GOTO finish
  372. ENDIF
  373. '
  374. ' okay, our user is in and all legit...
  375. @log(logfile$,"%","User entered correct password")
  376. '
  377. OPEN "O",#9,userdir$+uname$+".RLO",24
  378. '
  379. FOR k%=0 TO 9
  380.   '
  381.   IF aka$(k%)<>""
  382.     @msend(cr$+ansi$(5)+"Mail for AKA: "+ansi$(1)+aka$(k%)+cr$)
  383.     '
  384.     core$=STR$(aka%(k%,1))+"."+STR$(aka%(k%,2))+"."+STR$(aka%(k%,3))+"."+STR$(aka%(k%,4))+"."
  385.     '
  386.     IF EXIST(outbound$+core$+"HUT")
  387.       PRINT #9,"@"+outbound$+core$+"HUT"
  388.       @msend(ansi$(6)+outbound$+core$+"HUT"+cr$)
  389.     ENDIF
  390.     IF EXIST(outbound$+core$+"CUT")
  391.       PRINT #9,"@"+outbound$+core$+"CUT"
  392.       @msend(ansi$(6)+outbound$+core$+"CUT"+cr$)
  393.     ENDIF
  394.     IF EXIST(outbound$+core$+"DUT")
  395.       PRINT #9,"@"+outbound$+core$+"DUT"
  396.       @msend(ansi$(6)+outbound$+core$+"DUT"+cr$)
  397.     ENDIF
  398.     IF EXIST(outbound$+core$+"OUT")
  399.       PRINT #9,"@"+outbound$+core$+"OUT"
  400.       @msend(ansi$(6)+"@"+outbound$+core$+"OUT"+cr$)
  401.     ENDIF
  402.     '
  403.     IF EXIST(outbound$+core$+"FLO")
  404.       OPEN "I",#2,outbound$+core$+"FLO",1024
  405.       WHILE NOT EOF(#2)
  406.         LINE INPUT #2,xx$
  407.         IF LEFT$(xx$,1)<>"~"
  408.           PRINT #9,xx$
  409.           @msend(ansi$(6)+xx$+cr$)
  410.         ENDIF
  411.       WEND
  412.       CLOSE #2
  413.       '
  414.     ENDIF
  415.     '
  416.     IF EXIST(outbound$+core$+"HLO")
  417.       OPEN "I",#2,outbound$+core$+"HLO",1024
  418.       WHILE NOT EOF(#2)
  419.         LINE INPUT #2,xx$
  420.         IF LEFT$(xx$,1)<>"~"
  421.           PRINT #9,xx$
  422.           @msend(ansi$(6)+xx$+cr$)
  423.         ENDIF
  424.       WEND
  425.       CLOSE #2
  426.       '
  427.     ENDIF
  428.     '
  429.     IF EXIST(outbound$+core$+"CLO")
  430.       OPEN "I",#2,outbound$+core$+"CLO",1024
  431.       WHILE NOT EOF(#2)
  432.         LINE INPUT #2,xx$
  433.         IF LEFT$(xx$,1)<>"~"
  434.           PRINT #9,xx$
  435.           @msend(ansi$(6)+xx$+cr$)
  436.         ENDIF
  437.       WEND
  438.       CLOSE #2
  439.       '
  440.     ENDIF
  441.     '
  442.     IF EXIST(outbound$+core$+"DLO")
  443.       OPEN "I",#2,outbound$+core$+"DLO",1024
  444.       WHILE NOT EOF(#2)
  445.         LINE INPUT #2,xx$
  446.         IF LEFT$(xx$,1)<>"~"
  447.           PRINT #9,xx$
  448.           @msend(ansi$(6)+xx$+cr$)
  449.         ENDIF
  450.       WEND
  451.       CLOSE #2
  452.       '
  453.     ENDIF
  454.     '
  455.   ENDIF
  456.   '
  457. NEXT k%
  458. '
  459. CLOSE #9
  460. @killkeys
  461. @press
  462. '
  463. '
  464. @msend(CHR$(12)+cr$)
  465. @msend(ansi$(7)+"   ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"+cr$)
  466. @msend("   ³   "+ansi$(2)+"P l u t D o o r  "+ansi$(5)+"  -  "+ansi$(6)+"P i c k i n g   U p   Y o u r   M a i l   "+ansi$(7)+"³"+cr$)
  467. @msend("   ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"+cr$+cr$)
  468. '
  469. @msend(ansi$(7)+"------------------------------      ------"+cr$)
  470. @msend(ansi$(3)+"Summary of mail/files for you:      Bytes:"+cr$)
  471. @msend(ansi$(7)+"------------------------------      ------"+cr$+cr$)
  472. '
  473. OPEN "I",#2,userdir$+uname$+".RLO",1024
  474. '
  475. totalbytes%=0
  476. totalfiles%=0
  477. rlolen%=0
  478. '
  479. WHILE NOT EOF(#2)
  480.   LINE INPUT #2,xx$
  481.   IF LEFT$(xx$,1)="~"
  482.     xx$="~~"+xx$
  483.   ENDIF
  484.   IF LEFT$(xx$,1)="^" OR LEFT$(xx$,1)="@" OR LEFT$(xx$,1)="#" OR LEFT$(xx$,1)="-"
  485.     xx$=RIGHT$(xx$,LEN(xx$)-1)
  486.   ENDIF
  487.   '
  488.   IF LEFT$(xx$,1)<>"~"
  489.     IF EXIST(xx$)
  490.       spaceout(xx$,36)
  491.       @msend(ansi$(6)+xx$+SPACE$(spc%))
  492.       OPEN "I",#5,xx$,10
  493.       xx%=LOF(#5)
  494.       CLOSE #5
  495.       INC totalfiles%
  496.       totalbytes%=totalbytes%+xx%
  497.       @spaceout(STR$(xx%),6)
  498.       @msend(ansi$(2)+SPACE$(spc%)+STR$(xx%)+cr$)
  499.       rlolen%=rlolen%+LEN(xx$)
  500.     ELSE
  501.       xx%=0
  502.     ENDIF
  503.   ENDIF
  504.   '
  505.   IF totalfiles% MOD 23=16
  506.     @killkeys
  507.     @pagepause
  508.   ENDIF
  509.   '
  510. WEND
  511. CLOSE #2
  512. @msend(cr$+SPACE$(36)+ansi$(1)+"------")
  513. @spaceout(STR$(totalbytes%),6)
  514. @msend(cr$+SPACE$(36+spc%)+STR$(totalbytes%))
  515. @msend(cr$+SPACE$(36)+ansi$(1)+"------"+cr$)
  516. @killkeys
  517. @pagepause
  518. '
  519. sends%=(rlolen%/200)+1
  520. '
  521. @log(logfile$,"%","User has "+STR$(totalbytes%)+" bytes in "+STR$(totalfiles%)+" files here")
  522. '
  523. a$="This will take "+STR$(sends%)+" batch send"
  524. IF sends%<>1
  525.   a$=a$+"s"
  526. ENDIF
  527. @log(logfile$,"%",a$)
  528. '
  529. IF totalfiles%=0
  530.   @msend(cr$+cr$+ansi$(3)+"Well, whaddya know? No mail!")
  531.   @press
  532.   GOTO nomailjump
  533. ENDIF
  534. '
  535. '
  536. @msend(cr$+ansi$(5)+"The transfer consists of "+STR$(totalfiles%)+" file(s),")
  537. @msend(cr$+ansi$(5)+"which will require "+STR$(sends%)+" batch send")
  538. IF sends%<>1
  539.   @msend("s."+cr$)
  540. ELSE
  541.   @msend("."+cr$)
  542. ENDIF
  543. @msend(cr$+ansi$(2)+"At  1200 baud non-MNP, approx "+ansi$(3)+STR$(ROUND((totalbytes%/115)/60))+ansi$(2)+" mins")
  544. @msend(cr$+ansi$(2)+"At  2400 baud non-MNP, approx "+ansi$(3)+STR$(ROUND((totalbytes%/230)/60))+ansi$(2)+" mins")
  545. @msend(cr$+ansi$(2)+"At  2400 baud MNP-4,   approx "+ansi$(3)+STR$(ROUND((totalbytes%/270)/60))+ansi$(2)+" mins")
  546. @msend(cr$+ansi$(2)+"At  9600 baud non-MNP, approx "+ansi$(3)+STR$(ROUND((totalbytes%/940)/60))+ansi$(2)+" mins")
  547. @msend(cr$+ansi$(2)+"At  9600 baud MNP-4,   approx "+ansi$(3)+STR$(ROUND((totalbytes%/1100)/60))+ansi$(2)+" mins")
  548. @msend(cr$+ansi$(2)+"At 14400 baud non-MNP, approx "+ansi$(3)+STR$(ROUND((totalbytes%/1400)/60))+ansi$(2)+" mins")
  549. @msend(cr$+ansi$(2)+"At 14400 baud MNP-4,   approx "+ansi$(3)+STR$(ROUND((totalbytes%/1650)/60))+ansi$(2)+" mins")
  550. @msend(cr$+ansi$(2)+"At 28800 baud non-MNP, approx "+ansi$(3)+STR$(ROUND((totalbytes%/2800)/60))+ansi$(2)+" mins")
  551. @msend(cr$+ansi$(2)+"At 28800 baud MNP-4,   approx "+ansi$(3)+STR$(ROUND((totalbytes%/3100)/60))+ansi$(2)+" mins")
  552. @killkeys
  553. @press
  554. @killkeys
  555. @msend(cr$+ansi$(1)+CHR$(7)+"Commence the download (Y/n)? ")
  556. @mget(3,1,1,1)
  557. IF car%>0
  558.   GOTO finish
  559. ENDIF
  560. IF in$="NO"
  561.   @log(logfile$,"%","User rejected the download")
  562.   GOTO nomailjump
  563. ENDIF
  564. '
  565. '
  566. @chooseproto
  567. IF car%>0
  568.   GOTO finish
  569. ENDIF
  570. '
  571. @killkeys
  572. @msend(cr$+cr$)
  573. SELECT protocol%
  574. CASE 1
  575.   @msend(ansi$(5)+"(Last chance) Commence SZmodem download (Y/n)? ")
  576. CASE 2
  577.   @msend(ansi$(5)+"(Last chance) Commence Ymodem download (Y/n)? ")
  578. DEFAULT
  579.   @msend(ansi$(5)+"(Last chance) Commence Zmodem download (Y/n)? ")
  580. ENDSELECT
  581. '
  582. @mget(3,1,1,1)
  583. IF car%>0
  584.   GOTO finish
  585. ELSE IF in$="NO"
  586.   @log(logfile$,"%","User rejected the download")
  587.   GOTO nomailjump
  588. ENDIF
  589. '
  590. '
  591. '
  592. OPEN "I",#2,userdir$+uname$+".RLO",1024
  593. '
  594. persend%=totalfiles%/sends%
  595. '
  596. cmdline$=""
  597. jj%=1
  598. WHILE jj%<sends%
  599.   @msend(ansi$(3)+cr$+"Copying and renaming files...")
  600.   '
  601.   FOR k%=1 TO persend%
  602.     LINE INPUT #2,xx$
  603.     IF LEFT$(xx$,1)<>"~"
  604.       cmdline%=cmdline%+LEN(xx$)+1
  605.       '
  606.       IF LEFT$(xx$,1)="#"
  607.         a$=HEX$(TIMER,8)
  608.         fl$=RIGHT$(xx$,LEN(xx$)-1)
  609.         mo$=RIGHT$(fl$,4)
  610.         ex$="Copy "+CHR$(34)+fl$+CHR$(34)+" to "+CHR$(34)+xferdir$+a$+mo$+CHR$(34)
  611.         @log(logfile$,"%",ex$)
  612.         EXEC ex$,-1,-1
  613.         @msend(".")
  614.         fl$=xferdir$+a$+mo$
  615.       ELSE IF LEFT$(xx$,1)="@"
  616.         a$=HEX$(TIMER,8)
  617.         fl$=RIGHT$(xx$,LEN(xx$)-1)
  618.         ex$="Copy "+CHR$(34)+fl$+CHR$(34)+" to "+CHR$(34)+xferdir$+a$+".PKT"+CHR$(34)
  619.         @log(logfile$,"%",ex$)
  620.         EXEC ex$,-1,-1
  621.         @msend(".")
  622.         fl$=xferdir$+a$+".PKT"
  623.       ELSE IF LEFT$(xx$,1)="^"
  624.         fl$=RIGHT$(xx$,LEN(xx$)-1)
  625.       ELSE IF LEFT$(xx$,1)="-"
  626.         fl$=RIGHT$(xx$,LEN(xx$)-1)
  627.       ELSE
  628.         fl$=xx$
  629.       ENDIF
  630.       '
  631.       fl$=TRIM$(fl$)
  632.       '
  633.       IF EXIST(fl$)
  634.         cmdline$=cmdline$+fl$+" "
  635.         '
  636.       ENDIF
  637.     ENDIF
  638.     '
  639.   NEXT k%
  640.   '
  641.   @msend(cr$+cr$)
  642.   @xfer(protocol%,"S",cmdline$,persend%)
  643.   cmdline$=""
  644.   '
  645.   jumpout!=FALSE
  646.   '
  647.   @log(logfile$,"%","Download "+STR$(jj%)+" returned "+STR$(m67%(0)))
  648.   IF xfer.ret!=FALSE
  649.     @msend(cr$+cr$+"File transfer failed!!")
  650.     @msend(cr$+cr$+ansi$(1)+"Quit downloading (Y/n)? ")
  651.     @mget(3,1,1,1)
  652.     IF in$="YES" OR car%>0
  653.       jumpout!=TRUE
  654.       jj%=sends%+99
  655.       IF in$="YES"
  656.         @log(logfile$,"%","User quits download")
  657.       ENDIF
  658.     ENDIF
  659.   ENDIF
  660.   '
  661.   IF NOT jumpout!
  662.     @msend(cr$+cr$+ansi$(1)+"Ready for next (Y/n)? ")
  663.     @mget(3,1,1,1)
  664.     IF in$="NO" OR car%>0
  665.       jumpout!=TRUE
  666.       jj%=sends%+99
  667.       IF in$="NO"
  668.         @log(logfile$,"%","User quits download")
  669.       ENDIF
  670.     ENDIF
  671.     INC jj%
  672.   ENDIF
  673.   '
  674. WEND
  675. '
  676. IF car%>0
  677.   CLOSE #2
  678.   GOTO finish
  679. ENDIF
  680. IF jumpout!
  681.   CLOSE #2
  682.   GOTO nomailjump
  683. ENDIF
  684. '
  685. '
  686. cmdline$=""
  687. persend%=0
  688. @msend(ansi$(3)+cr$+"Copying and renaming files...")
  689. WHILE NOT EOF(#2)
  690.   LINE INPUT #2,xx$
  691.   IF LEFT$(xx$,1)<>"~"
  692.     cmdline%=cmdline%+LEN(xx$)+1
  693.     '
  694.     IF LEFT$(xx$,1)="#"
  695.       a$=HEX$(TIMER,8)
  696.       fl$=RIGHT$(xx$,LEN(xx$)-1)
  697.       mo$=RIGHT$(fl$,4)
  698.       ex$="Copy "+CHR$(34)+fl$+CHR$(34)+" to "+CHR$(34)+xferdir$+a$+mo$+CHR$(34)
  699.       @log(logfile$,"%",ex$)
  700.       EXEC ex$,-1,-1
  701.       @msend(".")
  702.       fl$=xferdir$+a$+mo$
  703.     ELSE IF LEFT$(xx$,1)="@"
  704.       a$=HEX$(TIMER,8)
  705.       fl$=RIGHT$(xx$,LEN(xx$)-1)
  706.       ex$="Copy "+CHR$(34)+fl$+CHR$(34)+" to "+CHR$(34)+xferdir$+a$+".PKT"+CHR$(34)
  707.       @log(logfile$,"%",ex$)
  708.       EXEC ex$,-1,-1
  709.       @msend(".")
  710.       fl$=xferdir$+a$+".PKT"
  711.     ELSE IF LEFT$(xx$,1)="^"
  712.       fl$=RIGHT$(xx$,LEN(xx$)-1)
  713.     ELSE IF LEFT$(xx$,1)="-"
  714.       fl$=RIGHT$(xx$,LEN(xx$)-1)
  715.     ELSE
  716.       fl$=xx$
  717.     ENDIF
  718.     '
  719.     fl$=TRIM$(fl$)
  720.     '
  721.     IF EXIST(fl$)
  722.       cmdline$=cmdline$+fl$+" "
  723.       INC persend%
  724.       '
  725.     ENDIF
  726.   ENDIF
  727.   '
  728. WEND
  729. CLOSE #2
  730. '
  731. @msend(cr$+cr$)
  732. @xfer(protocol%,"S",cmdline$,persend%)
  733. @log(logfile$,"%","Download "+STR$(jj%)+" returned "+STR$(m67%(0)))
  734. '
  735. IF xfer.ret!=FALSE
  736.   @msend(cr$+cr$+"File transfer failed!!")
  737.   @msend(cr$+cr$+ansi$(1)+"Do you want to quit (Y/n)? ")
  738.   @mget(3,1,1,1)
  739.   IF in$="YES" OR car%>0
  740.     IF in$="YES"
  741.       @log(logfile$,"%","User elects to quit")
  742.     ENDIF
  743.     GOTO finish
  744.   ENDIF
  745. ENDIF
  746. '
  747. @beepthree
  748. @msend(cr$+cr$+cr$+ansi$(3)+"Okay. Now the file transfer is over.")
  749. @msend(cr$+"If the transfer was succesful, you will want")
  750. @msend(cr$+"us to clean up the directories, so you don't")
  751. @msend(cr$+"get this mail sent to you again.")
  752. @msend(cr$+cr$+ansi$(5)+"This command will be final!")
  753. @msend(cr$+cr$+ansi$(2)+"Shall we clean up the directories (Y/n)? ")
  754. @mget(3,1,1,1)
  755. IF car%>0
  756.   GOTO finish
  757. ENDIF
  758. IF in$="NO"
  759.   @log(logfile$,"%","NO directory purging selected")
  760.   GOTO nomailjump
  761. ENDIF
  762. '
  763. @msend(cr$+cr$+ansi$(6)+"Are you sure (Y/n)? ")
  764. @mget(3,1,1,1)
  765. IF car%>0
  766.   GOTO finish
  767. ENDIF
  768. IF in$="NO"
  769.   @log(logfile$,"%","NO directory purging selected")
  770.   GOTO nomailjump
  771. ENDIF
  772. '
  773. OPEN "I",#2,userdir$+uname$+".RLO",1024
  774. @log(logfile$,"%","Purging "+outbound$+" directory")
  775. '
  776. WHILE NOT EOF(#2)
  777.   LINE INPUT #2,xx$
  778.   '
  779.   IF LEFT$(xx$,1)="#"
  780.     fl$=RIGHT$(xx$,LEN(xx$)-1)
  781.     @msend(cr$+ansi$(5)+"Truncating "+fl$+" to zero bytes")
  782.     @log(logfile$,"%","Truncating "+fl$+" to zero bytes")
  783.     OPEN "O",#5,fl$,24
  784.     PRINT #5,"";
  785.     CLOSE #5
  786.   ELSE IF LEFT$(xx$,1)="@" OR LEFT$(xx$,1)="^" OR LEFT$(xx$,1)="-"
  787.     fl$=RIGHT$(xx$,LEN(xx$)-1)
  788.     @msend(cr$+ansi$(1)+"Deleting "+fl$)
  789.     @log(logfile$,"%","Deleting "+fl$)
  790.     IF EXIST(fl$)
  791.       KILL fl$
  792.     ENDIF
  793.   ENDIF
  794.   '
  795. WEND
  796. '
  797. CLOSE #2
  798. '
  799. FOR k%=0 TO 9
  800.   core$=outbound$+STR$(aka%(k%,1))+"."+STR$(aka%(k%,2))+"."+STR$(aka%(k%,3))+"."+STR$(aka%(k%,4))+"."
  801.   IF EXIST(core$+"FLO")
  802.     @log(logfile$,"%","Deleting "+core$+"FLO")
  803.     @msend(cr$+ansi$(3)+"Deleting "+core$+"FLO")
  804.     KILL core$+"FLO"
  805.   ENDIF
  806.   IF EXIST(core$+"HLO")
  807.     @log(logfile$,"%","Deleting "+core$+"HLO")
  808.     @msend(cr$+ansi$(3)+"Deleting "+core$+"HLO")
  809.     KILL core$+"HLO"
  810.   ENDIF
  811.   IF EXIST(core$+"CLO")
  812.     @log(logfile$,"%","Deleting "+core$+"CLO")
  813.     @msend(cr$+ansi$(3)+"Deleting "+core$+"CLO")
  814.     KILL core$+"CLO"
  815.   ENDIF
  816.   IF EXIST(core$+"DLO")
  817.     @log(logfile$,"%","Deleting "+core$+"DLO")
  818.     @msend(cr$+ansi$(3)+"Deleting "+core$+"DLO")
  819.     KILL core$+"DLO"
  820.   ENDIF
  821. NEXT k%
  822. @press
  823. '
  824. nomailjump:
  825. '
  826. ex$="Delete "+xferdir$+"#?"
  827. @log(logfile$,"%",ex$)
  828. EXEC ex$,-1,-1
  829. '
  830. IF ring!
  831.   @chk_car
  832. ENDIF
  833. IF car%>0
  834.   GOTO finish
  835. ENDIF
  836. '
  837. ' They're sending mail TO US
  838. '
  839. @msend(CHR$(12)+ansi$(0))
  840. @msend(ansi$(7)+"   ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"+cr$)
  841. @msend("   ³ "+ansi$(2)+"P l u t D o o r "+ansi$(5)+" - "+ansi$(3)+"S e n d i n g   U s   Y o u r   R e p l i e s  "+ansi$(7)+"³"+cr$)
  842. @msend("   ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"+cr$+cr$)
  843. '
  844. IF EXIST(userdir$+uname$+".RLO")
  845.   @log(logfile$,"%","Deleting .RLO file")
  846.   KILL userdir$+uname$+".RLO"
  847. ENDIF
  848. '
  849. @msend(ansi$(1)+"F'reqs are now also available - just ensure the extension is '.REQ'."+cr$+cr$)
  850. @msend(ansi$(6)+"Do you have mail or F'reqs to send back (y/N)? ")
  851. @mget(3,1,0,1)
  852. '
  853. IF in$="NO" OR car%>0
  854.   IF in$="NO"
  855.     @log(logfile$,"%","User has nothing for us :-(")
  856.   ENDIF
  857.   GOTO finish
  858. ENDIF
  859. '
  860. @log(logfile$,"%","User says there is mail for us!")
  861. @chooseproto
  862. @xfer(protocol%,"R","",10)
  863. @log(logfile$,"%","Upload returned "+STR$(m67%(0)))
  864. '
  865. DIR xferdir$ TO "ram:pl.foo"
  866. '
  867. IF NOT EXIST("Ram:pl.foo")
  868.   @log(logfile$,"%","No files received!")
  869.   @msend(cr$+cr$+"no files received!")
  870.   @press
  871.   GOTO finish
  872. ENDIF
  873. '
  874. @msend(cr$+ansi$(6)+"Copying your files to "+inbound$+"..."+cr$)
  875. OPEN "I",#2,"ram:pl.foo",1024
  876. '
  877. IF LOF(#2)=0
  878.   CLOSE #2
  879.   @log(logfile$,"%","No files received!")
  880.   @msend(cr$+cr$+"no files received!")
  881.   @press
  882.   GOTO finish
  883. ENDIF
  884. '
  885. WHILE NOT EOF(#2)
  886.   LINE INPUT #2,xx$
  887.   xx$=TRIM$(xx$)
  888.   @log(logfile$,"%","Received file: "+xx$)
  889.   callfreq!=FALSE
  890.   @msend(cr$+ansi$(2)+"Received file: "+ansi$(1)+xx$)
  891.   xx$=UPPER$(xx$)
  892.   '
  893.   IF LEN(xx$)<4
  894.     xx$="XXX.XXX"
  895.   ENDIF
  896.   '
  897.   mo$=RIGHT$(xx$,4)
  898.   mo.short$=MID$(mo$,2,2)
  899.   pewdy$=HEX$(TIMER,8)
  900.   '
  901.   IF mo$=".REQ"
  902.     @msend(cr$+cr$+CHR$(7)+ansi$(3)+"Calling File Request Server...")
  903.     @log(logfile$,"%","Calling F'req Server")
  904.     callfreq!=TRUE
  905.     ex$="copy "+xx$+" to Ram:PlutDoor.REQ"
  906.     EXEC ex$,-1,-1
  907.     ex$="Delete "+xx$
  908.     EXEC ex$,-1,-1
  909.     ex$=freqhandler$
  910.   ELSE IF mo$=".OUT" OR mo$=".DUT" OR mo$=".CUT" OR mo$=".HUT" OR mo$=".PKT"
  911.     ex$="Copy "+xferdir$+xx$+" to "+inbound$+pewdy$+".PKT"
  912.     @log(logfile$,"%","Renamed "+xx$+" as "+pewdy$+".PKT")
  913.   ELSE IF mo.short$="MO"
  914.     ex$="Copy "+xferdir$+xx$+" to "+inbound$+pewdy$+mo$
  915.     @log(logfile$,"%","Renamed "+xx$+" as "+pewdy$+mo$)
  916.   ELSE IF mo.short$="TU"
  917.     ex$="Copy "+xferdir$+xx$+" to "+inbound$+pewdy$+mo$
  918.     @log(logfile$,"%","Renamed "+xx$+" as "+pewdy$+mo$)
  919.   ELSE IF mo.short$="WE"
  920.     ex$="Copy "+xferdir$+xx$+" to "+inbound$+pewdy$+mo$
  921.     @log(logfile$,"%","Renamed "+xx$+" as "+pewdy$+mo$)
  922.   ELSE IF mo.short$="TH"
  923.     ex$="Copy "+xferdir$+xx$+" to "+inbound$+pewdy$+mo$
  924.     @log(logfile$,"%","Renamed "+xx$+" as "+pewdy$+mo$)
  925.   ELSE IF mo.short$="FR"
  926.     ex$="Copy "+xferdir$+xx$+" to "+inbound$+pewdy$+mo$
  927.     @log(logfile$,"%","Renamed "+xx$+" as "+pewdy$+mo$)
  928.   ELSE IF mo.short$="SA"
  929.     ex$="Copy "+xferdir$+xx$+" to "+inbound$+pewdy$+mo$
  930.     @log(logfile$,"%","Renamed "+xx$+" as "+pewdy$+mo$)
  931.   ELSE IF mo.short$="SU"
  932.     ex$="Copy "+xferdir$+xx$+" to "+inbound$+pewdy$+mo$
  933.     @log(logfile$,"%","Renamed "+xx$+" as "+pewdy$+mo$)
  934.   ELSE IF mo$=".FLO"
  935.     @msend(cr$+ansi$(6)+"Please DON'T send *.FLO files back! Deleting this one!"+CHR$(7))
  936.     ex$="Delete "+xferdir$+xx$
  937.   ELSE IF mo$=".HLO"
  938.     @msend(cr$+ansi$(6)+"Please DON'T send *.HLO files back! Deleting this one!"+CHR$(7))
  939.     ex$="Delete "+xferdir$+xx$
  940.   ELSE IF mo$=".CLO"
  941.     @msend(cr$+ansi$(6)+"Please DON'T send *.CLO files back! Deleting this one!"+CHR$(7))
  942.     ex$="Delete "+xferdir$+xx$
  943.   ELSE IF mo$=".DLO"
  944.     @msend(cr$+ansi$(6)+"Please DON'T send *.DLO files back! Deleting this one!"+CHR$(7))
  945.     ex$="Delete "+xferdir$+xx$
  946.   ELSE IF NOT EXIST(inbound$+xx$)
  947.     ex$="Copy "+xferdir$+xx$+" to "+inbound$
  948.   ELSE
  949.     ex$="Copy "+xferdir$+xx$+" to "+inbound$+pewdy$+mo$
  950.     @log(logfile$,"%","No MAIL filename avail. Renaming to "+pewdy$+mo$)
  951.   ENDIF
  952.   '
  953.   EXEC ex$,-1,-1
  954.   '
  955.   IF callfreq!=TRUE
  956.     @msend(".... file server returns!"+cr$)
  957.     IF EXIST("Ram:PlutDoor.REQ")
  958.       KILL "Ram:PlutDoor.REQ"
  959.     ENDIF
  960.   ENDIF
  961.   '
  962. WEND
  963. CLOSE #2
  964. '
  965. '
  966. cmdline%=0
  967. cmdline$=""
  968. sends%=0
  969. this%=0
  970. jumpout!=FALSE
  971. '
  972. IF EXIST(userdir$+uname$+".RLO")
  973.   OPEN "I",#2,userdir$+uname$+".RLO",1024
  974.   '
  975.   DO WHILE NOT EOF(#2)
  976.     LINE INPUT #2,xx$
  977.     xx$=TRIM$(xx$)
  978.     '
  979.     IF LEFT$(xx$)="^"
  980.       xx$=RIGHT$(xx$,LEN(xx$)-1)
  981.     ELSE IF LEFT$(xx$)="-"
  982.       xx$=RIGHT$(xx$,LEN(xx$)-1)
  983.     ENDIF
  984.     '
  985.     IF EXIST(xx$)
  986.       INC this%
  987.       cmdline$=cmdline$+" "+xx$
  988.       cmdline%=LEN(cmdline$)
  989.     ENDIF
  990.     '
  991.     IF cmdline%>180
  992.       INC sends%
  993.       @msend(cr$+cr$)
  994.       @msend(ansi$(7)+"File send # "+STR$(sends%))
  995.       @xfer(protocol%,"S",cmdline$,this%)
  996.       @log(logfile$,"%","Download "+STR$(sends%)+" returned "+STR$(m67%(0)))
  997.       this%=0
  998.       cmdline$=""
  999.       '
  1000.       IF (xfer.ret!=FALSE) AND (car%=0)
  1001.         @msend(cr$+cr$+"File transfer failed!!")
  1002.         @msend(cr$+cr$+ansi$(1)+"Do you want to quit (Y/n)? ")
  1003.         @mget(3,1,1,1)
  1004.         IF in$="YES" OR car%>0
  1005.           IF in$="YES"
  1006.             @log(logfile$,"%","User elects to quit")
  1007.           ENDIF
  1008.           jumpout!=TRUE
  1009.         ENDIF
  1010.       ENDIF
  1011.     ENDIF
  1012.     IF car%>0
  1013.       jumpout!=TRUE
  1014.     ENDIF
  1015.     '
  1016.   LOOP UNTIL jumpout!=TRUE
  1017.   '
  1018.   CLOSE #2
  1019. ENDIF
  1020. IF cmdline$<>""
  1021.   '
  1022.   INC sends%
  1023.   @msend(cr$+cr$)
  1024.   @msend(ansi$(7)+"File send # "+STR$(sends%))
  1025.   @xfer(protocol%,"S",cmdline$,this%)
  1026.   @log(logfile$,"%","Download "+STR$(sends%)+" returned "+STR$(m67%(0)))
  1027.   '
  1028. ENDIF
  1029. '
  1030. '
  1031. @msend(cr$+cr$+ansi$(5)+"Thank you. Until we meet again...")
  1032. '
  1033. DELAY 1
  1034. '
  1035. bye:
  1036. '
  1037. xq3%=0
  1038. '
  1039. finish:
  1040. '
  1041. @killkeys
  1042. @msend(CHR$(12)+cr$+cr$+ansi$(0))
  1043. @msend(cr$+"Program  : "+doorname$)
  1044. @msend(cr$+"Author   : Peter Deane")
  1045. @msend(cr$+"Version  : "+versnum$)
  1046. @msend(cr$+"Date     : "+versdate$)
  1047. @msend(cr$+"Language : GFA Basic"+cr$)
  1048. @pagepause
  1049. @msend("Reloading: "+bbsname$+cr$+cr$)
  1050. '
  1051. IF EXIST("RAM:userdata")
  1052.   KILL "RAM:userdata"
  1053. ENDIF
  1054. '
  1055. IF EXIST("t:Xfers.temp")
  1056.   KILL "t:Xfers.temp"
  1057. ENDIF
  1058. '
  1059. IF EXIST("ram:pl.foo")
  1060.   KILL "ram:pl.foo"
  1061. ENDIF
  1062. '
  1063. IF arpbase%
  1064.   ~CloseLibrary(arpbase%)
  1065. ENDIF
  1066. '
  1067. ex$="delete "+xferdir$+"#?"
  1068. @log(logfile$,"%",ex$)
  1069. EXEC ex$,-1,-1
  1070. '
  1071. ex$="delete T:#?.PKT"
  1072. @log(logfile$,"%",ex$)
  1073. EXEC ex$,-1,-1
  1074. '
  1075. IF EXIST(userdir$+uname$+".RLO")
  1076.   @log(logfile$,"%","Deleting .RLO file")
  1077.   KILL userdir$+uname$+".RLO"
  1078. ENDIF
  1079. '
  1080. IF ring!=TRUE
  1081.   IF car%>0
  1082.     @log(logfile$,"%","User dropped carrier!")
  1083.   ENDIF
  1084.   @close_serial
  1085. ENDIF
  1086. '
  1087. CLOSES 1
  1088. '
  1089. @log(logfile$,"%","PlutDoor V"+versnum$+" closed"+CHR$(10))
  1090. '
  1091. CLEAR
  1092. END
  1093. '
  1094. '
  1095. PROCEDURE woops
  1096.   '
  1097.   @log(logfile$,"%","Entered Error Trapping Code!!")
  1098.   @msend(cr$+CHR$(7)+cr$+ansi$(1)+"Woops - FATAL ERROR!!"+cr$)
  1099.   @msend(cr$+CHR$(7)+"This will be logged for the sysop. You may even be able"+cr$)
  1100.   @msend("to re-run the door, and have it work fine - just try to avoid what you"+cr$)
  1101.   @msend("just did then!"+cr$)
  1102.   @msend(cr$+cr$+"Exiting door now. Please hold")
  1103.   DELAY 1
  1104.   @msend("..5..")
  1105.   DELAY 1
  1106.   @msend("4..")
  1107.   DELAY 1
  1108.   @msend("3..")
  1109.   DELAY 1
  1110.   @msend("2..")
  1111.   DELAY 1
  1112.   @msend("1..")
  1113.   DELAY 1
  1114.   @msend("0..")
  1115.   '
  1116.   RESUME finish
  1117.   '
  1118. RETURN
  1119. '
  1120. '
  1121. '
  1122. '
  1123. '
  1124. '
  1125. PROCEDURE open_serial
  1126.   '
  1127.   cmd_read%=2              ! Similar to INPUT #1,
  1128.   cmd_write%=3             ! Similar to PRINT #1,
  1129.   cmd_clear%=5
  1130.   sdcmd_break%=10          ! Special Serial Device commands
  1131.   sdcmd_query%=9           ! This command polls the serial device for how many chars to read
  1132.   sdcmd_setparams%=11      ! We will use this to adjust the buffer size **********
  1133.   '
  1134.   io.command%=28           ! 2 byte command to perform (see directly above)
  1135.   io.flags%=30             ! 1 byte
  1136.   io.error%=31             ! 1 byte error # of last command
  1137.   io.actual%=32            ! 4 byte actual bytes read or written
  1138.   io.length%=36            ! 4 byte length of data to read or write
  1139.   io.data%=40              ! 4 byte address of data to send or recieve
  1140.   io.offset%=44            ! 4 byte ???
  1141.   io.ctlchar%=48           ! 4 byte handshaking = $11130000
  1142.   io.rbufflen%=52          ! 4 byte suggested size of the hardware buffer (16K ?)
  1143.   io.extflags%=56          ! 4 byte parity flags for serial port/modem
  1144.   io.baud%=60              ! 4 byte actual baud rate to use (1200, 2400, etc.)
  1145.   io.brktime%=64           ! 4 byte break time in micro seconds (250000 ?)
  1146.   io.termarray%=68         ! 8 byte a list of 8 termination characters (???????)
  1147.   io.readlen%=76           ! 1 byte # of bits per read character (7-8)
  1148.   io.writelen%=77          ! 1 byte # of bits per write character (should be same as read)
  1149.   io.stopbits%=78          ! 1 byte # of stop bits (1 or 2)
  1150.   io.serflags%=79          ! 1 byte serial port flags -
  1151.   '
  1152.   iof_quick%=1
  1153.   '
  1154.   serf_7wire|=4
  1155.   serf_eofmode|=64
  1156.   serf_parity_odd|=2
  1157.   serf_parity_on|=1
  1158.   serf_queuedbrk|=8
  1159.   serf_rad_boogie|=16
  1160.   serf_shared|=32         !This is the flag to set at OpenDevice for shared mode
  1161.   serf_xdisabled|=128     !this flag should also be set at OpenDevice
  1162.   '
  1163.   io.status%=80           ! 2 bytes set when we issue a SDCMD_QUERY
  1164.   '                      Bit# | what its for
  1165.   '                         0 = reserved
  1166.   '                         1 = reserved
  1167.   '                         2 = ring indicator on 500/2000
  1168.   '                         3 = Data set ready      (DSR)
  1169.   '                         4 = Clear To Send       (CTS)
  1170.   '                         5 = Carrier Detect      (CD)
  1171.   '                         6 = Ready to send       (RTS)
  1172.   '                         7 = Data Terminal Ready (DTR)
  1173.   '                         8 = Read overrun
  1174.   '                         9 = Break sent
  1175.   '                        10 = Break recieved
  1176.   '                        11 = transmit x-OFFed
  1177.   '                        12 = receive x-OFFed
  1178.   '
  1179.   sizeof_extserio%=82      ! The size of the ExtSerIO struct
  1180.   '
  1181.   '
  1182.   ' open the modem
  1183.   '
  1184.   device_name$=device$+CHR$(0)
  1185.   '
  1186.   write_port%=CreatePort(0,0)
  1187.   write_io%=CreateExtIO(write_port%,sizeof_extserio%)
  1188.   read_port%=CreatePort(0,0)
  1189.   read_io%=CreateExtIO(read_port%,sizeof_extserio%)
  1190.   '
  1191.   ' serf_7wire| is the flag for CTS/RTS
  1192.   '
  1193.   POKE write_io%+io.serflags%,serf_7wire|+serf_shared|+serf_xdisabled|
  1194.   '
  1195.   ~OpenDevice(V:device_name$,unit%,write_io%,0) ! Open the device
  1196.   '
  1197.   LPOKE write_io%+io.baud%,bd%                  ! baud rate
  1198.   POKE write_io%+io.readlen%,8                  ! # read bits
  1199.   POKE write_io%+io.writelen%,8                 ! # write bits
  1200.   POKE write_io%+io.stopbits,1                  ! Stop bits - 1 please
  1201.   LPOKE write_io%+io.ctlchar%,&H1113000         ! handshaking
  1202.   LPOKE write_io%+io.rbufflen%,512              ! hardware buffer size
  1203.   DPOKE write_io%+io.command%,sdcmd_setparams%
  1204.   ~DoIO(write_io%)
  1205.   '
  1206.   ' now copy the write_io request into the read_io request
  1207.   '
  1208.   FOR a%=20 TO sizeof_extserio%
  1209.     POKE read_io%+a%,PEEK(write_io%+a%)
  1210.   NEXT a%
  1211. RETURN
  1212. '
  1213. PROCEDURE close_serial
  1214.   ' close the modem
  1215.   ~AbortIO(write_io%)
  1216.   ~WaitIO(write_io%)
  1217.   ~CloseDevice(write_io%)
  1218.   '
  1219.   ' free up the memory of the IO request structure (must be 88!)
  1220.   '
  1221.   ~MFREE(write_io%,88)
  1222.   ~MFREE(read_io%,88)
  1223.   '
  1224.   ' Delete the message port
  1225.   '
  1226.   ~DeletePort(write_port%)
  1227.   ~DeletePort(read_port%)
  1228. RETURN
  1229. '
  1230. '
  1231. PROCEDURE ser_recv1
  1232.   ' read in data 1 byte at a time like a$=INPUT$(1,1)
  1233.   '
  1234.   ' first we check to see if there is any incoming data, and if so store the
  1235.   ' number of characters waiting in the variable waiting%
  1236.   '
  1237.   r_data$=""
  1238.   DPOKE read_io%+io.command%,sdcmd_query%
  1239.   ~DoIO(read_io%)
  1240.   waiting%=LPEEK(read_io%+io.actual%)
  1241.   IF waiting%<>0
  1242.     r_data$=SPACE$(1)
  1243.     DPOKE read_io%+io.command%,cmd_read%
  1244.     LPOKE read_io%+io.length%,1
  1245.     LPOKE read_io%+io.data%,V:r_data$
  1246.     ~DoIO(read_io%)
  1247.   ENDIF
  1248. RETURN
  1249. '
  1250. PROCEDURE ser_purge
  1251.   DPOKE read_io%+io.command%,cmd_clear%
  1252.   ~DoIO(read_io%)
  1253. RETURN
  1254. '
  1255. PROCEDURE killkeys
  1256.   IF ring!
  1257.     @ser_purge
  1258.   ENDIF
  1259.   WHILE INKEY$<>""
  1260.     foo$=INKEY$
  1261.   WEND
  1262. RETURN
  1263. '
  1264. PROCEDURE chk_car
  1265.   ' no carrier=-1  |  valid carrier=0
  1266.   '
  1267.   DPOKE write_io%+io.command%,sdcmd_query%
  1268.   ~DoIO(write_io%)
  1269.   status&=DPEEK(write_io%+io.status%)
  1270.   car!=BTST(status&,5)
  1271.   IF car!=TRUE
  1272.     car%=20
  1273.   ENDIF
  1274. RETURN
  1275. '
  1276. PROCEDURE set_baud(baud%)
  1277.   '
  1278.   ' baud%        = actual baud rate (300,1200,2400,etc)
  1279.   '
  1280.   LPOKE write_io%+io.baud%,baud%
  1281.   DPOKE write_io%+io.command%,sdcmd_setparams%
  1282.   ~DoIO(write_io%)
  1283. RETURN
  1284. '
  1285. PROCEDURE mget(intype%,inlength%,yesdef!,wait!)
  1286.   '
  1287.   ' [Usage @Mget(intype%,inlength%,yesdef!,wait!) ]
  1288.   '
  1289.   ' input type= 0  Hot key response. Converted to uppercase. Always 1 char
  1290.   '           = 1  Normal Upper/Lowercase text input.
  1291.   '           = 2  UPPERCASE only text input
  1292.   '           = 3  Yes/No response. Will default to YES if yesdef!=TRUE
  1293.   '           = 4  Numerical input only
  1294.   '           = 5  For the Metro Line Editor's use
  1295.   '           = 6  Non-echoed, all uppercase password stuff
  1296.   '           = 9  No echoing, converted to uppercase.
  1297.   '
  1298.   ' input length   Just how many chars you want (max)
  1299.   '
  1300.   ' yesdef!   = TRUE then if <rtn> pressed, default is 'YES'+cr$
  1301.   '           = FALSE then if <rtn> pressed, default is 'NO'+cr$
  1302.   '
  1303.   ' wait!     = TRUE, we'll wait until something is input
  1304.   '           = FALSE then if nothing pressed, we'll return and return
  1305.   '             in$=""
  1306.   '
  1307.   '
  1308.   LOCAL cd%,a$,key$,keyy%,b%,in1$,idle%,llen%
  1309.   '
  1310.   idle%=CINT(TIMER/200)
  1311.   ' /\ can't have them taking all day!
  1312.   '
  1313.   key$=""
  1314.   in$=""
  1315.   in1$=""
  1316.   a%=0
  1317.   keyy!=FALSE
  1318.   b%=0
  1319.   '
  1320.   DO
  1321.     '
  1322.     IF MOUSEK=3
  1323.       ALERT 0,"REALLY kill "+doorname$+" ?",2,"Yes|No",xx%
  1324.       IF xx%=1
  1325.         car%=999
  1326.         keyy!=TRUE
  1327.         abort!=TRUE
  1328.         '
  1329.       ENDIF
  1330.     ENDIF
  1331.     ' /\ a way out...
  1332.     '
  1333.     IF ring!=TRUE
  1334.       @chk_car
  1335.       IF car!=TRUE
  1336.         keyy!=TRUE
  1337.         abort!=TRUE
  1338.         ' set all the flags for an early departure! :-)
  1339.       ENDIF
  1340.     ENDIF
  1341.     '
  1342.     key$=INKEY$
  1343.     '
  1344.     IF LEN(key$)>1 AND LEFT$(key$,1)=CHR$(155)
  1345.       '
  1346.       xx%=ASC(MID$(key$,2,1))
  1347.       IF xx%=48         ! F1
  1348.         ALERT 0,"Really kick em off?",2,"Yes|No",xx%
  1349.         IF xx%=1
  1350.           car%=20
  1351.           keyy!=TRUE
  1352.           abort!=TRUE
  1353.         ENDIF
  1354.       ENDIF
  1355.       IF xx%=50         ! F3
  1356.         IF icon!=TRUE
  1357.           icon!=FALSE
  1358.           CLOSEW #2
  1359.         ELSE
  1360.           icon!=TRUE
  1361.           CLOSEW #2
  1362.         ENDIF
  1363.         @main_window
  1364.         ~ActivateWindow(WINDOW(2))
  1365.       ENDIF
  1366.     ENDIF
  1367.     '
  1368.     EXIT IF car!=TRUE
  1369.     '
  1370.     IF ring!=TRUE AND key$=""
  1371.       ' sep test for ring!=TRUE cos if no user - no modem!
  1372.       @ser_recv1
  1373.       IF r_data$<>""
  1374.         key$=r_data$
  1375.       ENDIF
  1376.     ENDIF
  1377.     '
  1378.     IF key$=CHR$(19)
  1379.       ' Wow, they pressed ctrl-S. Let's pause a bit.
  1380.       pau$=""
  1381.       hold%=CINT(TIMER/200)
  1382.       '
  1383.       WHILE CINT(TIMER/200)<hold%+45
  1384.         ' pause for a MAXIMUM of /\ 45 seconds
  1385.         pau$=INKEY$
  1386.         IF ring!=TRUE
  1387.           @ser_recv1
  1388.           pau$=r_data$
  1389.         ENDIF
  1390.         EXIT IF pau$<>""
  1391.       WEND
  1392.       '
  1393.       key$=""
  1394.       pau$=""
  1395.     ENDIF
  1396.     '
  1397.     ' This seemingly works well, but watchit if you are hotkeying a menu
  1398.     ' and using "S" or "N" as the keypresses- Remember to reset abort!
  1399.     ' \/ just in case it throws something a bit later on!
  1400.     '
  1401.     IF wait!=FALSE
  1402.       keyy!=TRUE
  1403.       IF key$=" " OR key$="N" OR key$="S" OR key$="n" OR key$="s" OR key$=CHR$(3)
  1404.         abort!=TRUE
  1405.       ENDIF
  1406.     ENDIF
  1407.     '
  1408.     IF key$=""
  1409.       GOTO getjump1
  1410.       ' /\ not worth running through the processing any further
  1411.     ENDIF
  1412.     '
  1413.     a%=ASC(key$)
  1414.     b%=LEN(in$)
  1415.     '
  1416.     IF (a%=8 OR a%=127) AND LEN(in$)>=1
  1417.       in$=LEFT$(in$,b%-1)
  1418.       DEC b%
  1419.       @msend(de$)
  1420.     ENDIF
  1421.     '
  1422.     IF b%=inlength%
  1423.       GOTO getjump1
  1424.     ENDIF
  1425.     '
  1426.     IF intype%=0
  1427.       IF a%>31 AND a%<126
  1428.         key$=UPPER$(key$)
  1429.         @msend(key$+cr$)
  1430.         in$=key$
  1431.         keyy!=TRUE
  1432.       ENDIF
  1433.       '
  1434.     ELSE IF intype%=1 AND a%>31 AND a%<126
  1435.       @msend(key$)
  1436.       in$=in$+key$
  1437.       '
  1438.     ELSE IF intype%=2 AND a%>31 AND a%<126
  1439.       key$=UPPER$(key$)
  1440.       @msend(key$)
  1441.       in$=in$+key$
  1442.       '
  1443.     ELSE IF intype%=3
  1444.       IF a%=13 AND yesdef!=TRUE
  1445.         @msend("YES")
  1446.         in$="YES"
  1447.         keyy!=TRUE
  1448.       ELSE IF a%=13 AND yesdef!=FALSE
  1449.         @msend("NO")
  1450.         in$="NO"
  1451.         keyy!=TRUE
  1452.       ELSE IF a%=89 OR a%=121
  1453.         @msend("YES"+cr$)
  1454.         in$="YES"
  1455.         keyy!=TRUE
  1456.       ELSE IF a%=78 OR a%=110
  1457.         @msend("NO"+cr$)
  1458.         in$="NO"
  1459.         keyy!=TRUE
  1460.       ENDIF
  1461.       '
  1462.     ELSE IF intype%=4 AND a%>47 AND a%<58
  1463.       @msend(key$)
  1464.       in$=in$+key$
  1465.       '
  1466.     ELSE IF intype%=5
  1467.       '
  1468.       ' DO NOT USE THIS unless using the line editor!!
  1469.       ' this will rely on dim'ing ln$() and keeping ln% as the line #
  1470.       '
  1471.       llen%=LEN(ln$(ln%))
  1472.       IF (a%=8 OR a%=127) AND llen%>=1
  1473.         ln$(ln%)=LEFT$(ln$(ln%),llen%-1)
  1474.         @msend(de$)
  1475.         keyy!=TRUE
  1476.       ELSE IF a%=13
  1477.         in$=key$
  1478.         keyy!=TRUE
  1479.       ELSE IF a%=9
  1480.         @msend("        ")
  1481.         in$="        "
  1482.         keyy!=TRUE
  1483.       ELSE IF (a%>=loascii%) AND (a%<>125) AND (a%<=hiascii%)
  1484.         @msend(key$)
  1485.         in$=key$
  1486.         keyy!=TRUE
  1487.       ENDIF
  1488.       '
  1489.     ELSE IF intype%=6 AND a%>31 AND a%<126
  1490.       key$=UPPER$(key$)
  1491.       @msend("*")
  1492.       in$=in$+key$
  1493.       '
  1494.     ELSE IF intype%=9
  1495.       ' no echoing of input and conversion to uppercase very handy -
  1496.       ' won't mess up your menus, etc, if they press the wrong keys.
  1497.       ' Remember to echo it yourself if so required... (ie @msend(in$))
  1498.       '
  1499.       IF (a%>31 AND a%<126) OR a%=13
  1500.         key$=UPPER$(key$)
  1501.         in$=key$
  1502.         keyy!=TRUE
  1503.       ENDIF
  1504.       '
  1505.       ' \/ Of modem get types!
  1506.     ENDIF
  1507.     '
  1508.     ' Well, if we needed to jump, come to here...
  1509.     getjump1:
  1510.     '
  1511.     ' Handle our carriage returns..
  1512.     IF a%=13
  1513.       IF (intype%<>5 AND intype%<>9)
  1514.         @msend(cr$)
  1515.       ENDIF
  1516.       keyy!=TRUE
  1517.     ENDIF
  1518.     ' Look after idle timer
  1519.     '
  1520.     IF CINT(TIMER/200)>idle%+300
  1521.       car%=5
  1522.       keyy!=TRUE
  1523.       abort!=TRUE
  1524.     ENDIF
  1525.     '
  1526.   LOOP UNTIL keyy!=TRUE
  1527.   '
  1528. RETURN
  1529. '
  1530. PROCEDURE msend(d$)
  1531.   '
  1532.   ' [Sends the string out to the screen and modem if needed]
  1533.   '
  1534.   IF ring!=TRUE
  1535.     @chk_car
  1536.     IF car!=FALSE
  1537.       ' send data string fred$ out to modem
  1538.       DPOKE write_io%+io.command%,cmd_write%
  1539.       LPOKE write_io%+io.length%,LEN(d$)
  1540.       LPOKE write_io%+io.data%,V:d$
  1541.       ~DoIO(write_io%)
  1542.     ENDIF
  1543.   ENDIF
  1544.   IF NOT icon!
  1545.     PRINT d$;
  1546.   ENDIF
  1547.   '
  1548. RETURN
  1549. '
  1550. '
  1551. PROCEDURE xfer(prot%,way$,flnm$,numfiles%)
  1552.   '
  1553.   IF ring!
  1554.     @chk_car
  1555.   ENDIF
  1556.   '
  1557.   IF car%>0
  1558.     GOTO xferexit
  1559.   ENDIF
  1560.   '
  1561.   FRONTS 1
  1562.   '
  1563.   '  prot%= a number from 0-2 - the selected protocol
  1564.   '  way$= "r" or "s"  (receive or send)
  1565.   '  flnm$=filename to send!
  1566.   '
  1567.   ' We need:
  1568.   '        npud$= name of program to call
  1569.   '        cpud$= command line to give it
  1570.   '
  1571.   CHDIR xferdir$
  1572.   '
  1573.   way$=" "+LEFT$(way$,1)+" "  ! first char only PLUS leading/trailing spaces
  1574.   IF way$<>" R " AND way$<>" S "
  1575.     back%=50
  1576.     GOTO xferdone
  1577.   ENDIF
  1578.   '
  1579.   IF EXIST("t:Xfers.temp")
  1580.     KILL "t:Xfers.temp"     ! in case we haven't cleaned up
  1581.   ENDIF
  1582.   '
  1583.   IF prot%=1
  1584.     ' SZmodem
  1585.     npud$="xprd"
  1586.     IF way$=" S "
  1587.       cpud$="-f -s -c -d"+device$+" -u"+STR$(unit%)+" -x"+STR$(bd%)+" -lxprszmodem.library -oTN,OR,B1,F0,AN,DN,KY,SN,RN S "+flnm$
  1588.     ELSE
  1589.       cpud$="-f -s -c -d"+device$+" -u"+STR$(unit%)+" -x"+STR$(bd%)+" -lxprszmodem.library -oTN,B1,F0,AN,DN,KY,SN,RN,P"+xferdir$+" R ram:Foo"
  1590.     ENDIF
  1591.   ELSE IF prot%=2
  1592.     ' Ymodem
  1593.     npud$="xprd"
  1594.     IF way$=" S "
  1595.       cpud$="-f -s -c -d"+device$+" -u"+STR$(unit%)+" -x"+STR$(bd%)+" -lxprymodem.library -oYB,Z1,C1,B1,O"+xferdir$+" S "+flnm$
  1596.     ELSE
  1597.       cpud$="-f -s -c -d"+device$+" -u"+STR$(unit%)+" -x"+STR$(bd%)+" -lxprymodem.library -oYB,Z1,C1,B1,O"+xferdir$+" R Ram:Foo "
  1598.     ENDIF
  1599.   ELSE
  1600.     ' Zmodem
  1601.     npud$="xprd"
  1602.     IF way$=" S "
  1603.       cpud$="-f -s -c -d"+device$+" -u"+STR$(unit%)+" -x"+STR$(bd%)+" -lxprzmodem.library -oTN,OR,B1,F0,AN,DN,KY,SN,RN S "+flnm$
  1604.     ELSE
  1605.       cpud$="-f -s -c -d"+device$+" -u"+STR$(unit%)+" -x"+STR$(bd%)+" -lxprzmodem.library -oTN,ON,B1,F0,AN,DN,KY,SN,RN,P"+xferdir$+" R ram:Foo"
  1606.     ENDIF
  1607.   ENDIF
  1608.   '
  1609.   IF way$=" S "
  1610.     @msend(cr$+CHR$(7)+ansi$(1)+"Sending file now. Hold Ctrl-X to abort!"+cr$)
  1611.   ELSE
  1612.     @msend(cr$+CHR$(7)+ansi$(1)+"Please start sending file now. Hold Ctrl-X to abort!"+cr$)
  1613.   ENDIF
  1614.   '
  1615.   npud$=npud$+CHR$(0)
  1616.   cpud$=cpud$+CHR$(0)
  1617.   npud%=V:npud$
  1618.   cpud%=V:cpud$
  1619.   @syncrun(npud%,cpud%)
  1620.   '
  1621.   xferdone:
  1622.   @beepthree
  1623.   IF ring!
  1624.     @chk_car
  1625.   ENDIF
  1626.   IF car%>0
  1627.     m67%(0)=20
  1628.     GOTO xferexit
  1629.   ENDIF
  1630.   '
  1631.   @msend(cr$+cr$+ansi$(6)+"Protocol returned "+ansi$(1)+STR$(m67%(0)))
  1632.   '
  1633.   IF m67%(0)=0
  1634.     @msend(ansi$(6)+" our guess:"+ansi$(2)+"  File Transfer Succesful!")
  1635.     xfer.ret!=TRUE
  1636.   ELSE
  1637.     @msend(ansi$(6)+" our guess:"+ansi$(1)+"  File Transfer FAILED!!!!")
  1638.     xfer.ret!=FALSE
  1639.   ENDIF
  1640.   '
  1641.   @press
  1642.   xferexit:
  1643. RETURN
  1644. '
  1645. '
  1646. PROCEDURE syncrun(name%,command%)
  1647.   '
  1648.   ' name%   =address of file to syncrun
  1649.   ' command%=address of the command line for that command.
  1650.   ' in%, out%=0
  1651.   IF arpbase%
  1652.     m67%(8)=name%
  1653.     m67%(9)=command%
  1654.     m67%(0)=0
  1655.     m67%(1)=0
  1656.     m67%(14)=arpbase%
  1657.     RCALL arpbase%-540,m67%()
  1658.   ENDIF
  1659.   IF arpbase%=0
  1660.     m67%(0)=20
  1661.   ENDIF
  1662. RETURN
  1663. '
  1664. '
  1665. PROCEDURE press
  1666.   @msend(cr$+cr$+ansi$(0)+"[Any_Key]")
  1667.   @mget(0,1,1,1)
  1668. RETURN
  1669. '
  1670. '
  1671. PROCEDURE open_screen
  1672.   OPENS 1,sx%,sy%,sw%,sh%,3,32768
  1673.   IF ring!=TRUE
  1674.     IF actwin!=FALSE
  1675.       BACKS 1
  1676.     ENDIF
  1677.   ENDIF
  1678.   '
  1679.   SETCOLOR 0,&H0
  1680.   SETCOLOR 1,&HF11
  1681.   SETCOLOR 2,&H1F1
  1682.   SETCOLOR 3,&HFF1
  1683.   SETCOLOR 4,&H55F
  1684.   SETCOLOR 5,&HF1F
  1685.   SETCOLOR 6,&H1FF
  1686.   SETCOLOR 7,&HFFF
  1687. RETURN
  1688. '
  1689. PROCEDURE main_window
  1690.   OPENW #2,0,11,sw%,sh%-11,0,2304,1
  1691.   IF icon!=TRUE
  1692.     PRINT
  1693.     PRINT
  1694.     PRINT ansi4$+"                        Now running in ICONISED mode"
  1695.     PRINT
  1696.     PRINT ansi3$+"                           NO local console output"
  1697.     PRINT
  1698.     PRINT ansi5$+"                       Press F3 to un-iconise the door"
  1699.   ENDIF
  1700.   '
  1701.   xx$=doorname$+" V"+versnum$+"    User: ["+uname$+"]  "
  1702.   IF ring!=TRUE
  1703.     xx$=xx$+"Remote - Baud:"+realbaud$
  1704.   ELSE
  1705.     xx$=xx$+"Local"
  1706.   ENDIF
  1707.   TITLEW #2,"",xx$
  1708.   TITLES #1,xx$
  1709.   IF ring!=FALSE
  1710.     ~ActivateWindow(WINDOW(2))
  1711.   ENDIF
  1712.   IF actwin!=TRUE
  1713.     ~ActivateWindow(WINDOW(2))
  1714.   ENDIF
  1715.   '
  1716. RETURN
  1717. '
  1718. '
  1719. PROCEDURE seq.out(file$)
  1720.   '
  1721.   IF NOT EXIST(file$)
  1722.     @msend(cr$+cr$+ansi$(1)+"'"+file$+"' Not found..."+ansi$(7))
  1723.     ' @press
  1724.   ELSE
  1725.     lncount%=0
  1726.     OPEN "I",#2,file$,4096
  1727.     '
  1728.     DO UNTIL EOF(#2)
  1729.       LINE INPUT #2,text$
  1730.       INC lncount%
  1731.       @msend(text$+cr$)
  1732.       @mget(9,1,0,0)
  1733.       IF lncount%>=scrnht%
  1734.         @pagepause
  1735.       ENDIF
  1736.       '
  1737.       EXIT IF (car%>0) OR abort!=TRUE
  1738.     LOOP
  1739.     '
  1740.     CLOSE #2
  1741.   ENDIF
  1742.   '
  1743.   IF car%<=0
  1744.     abort!=FALSE
  1745.     contin!=FALSE
  1746.     @msend(ansi$(0))
  1747.   ENDIF
  1748.   '
  1749. RETURN
  1750. '
  1751. '
  1752. PROCEDURE pagepause
  1753.   '
  1754.   @tchk
  1755.   IF contin!=TRUE OR abscontin!=TRUE OR car%>0
  1756.     GOTO pagepauseexit
  1757.   ENDIF
  1758.   '
  1759.   @msend("More (Y/n/c)?")
  1760.   @mget(9,1,0,1)
  1761.   IF car%>0
  1762.     GOTO pagepauseexit
  1763.   ENDIF
  1764.   @msend(de$+de$+de$+de$+de$+de$+de$+de$+de$+de$+de$+de$+de$)
  1765.   '
  1766.   IF in$=" " OR in$="N" OR in$="S"
  1767.     abort!=TRUE
  1768.   ELSE IF in$="C"
  1769.     contin!=TRUE
  1770.   ENDIF
  1771.   '
  1772.   pagepauseexit:
  1773.   lncount%=0
  1774.   '
  1775. RETURN
  1776. '
  1777. '
  1778. PROCEDURE log(log$,prefix$,entry$)
  1779.   '
  1780.   ' creates a Trapdoor-style log entry
  1781.   ' Inputs:
  1782.   '        log$  (filename of the log)
  1783.   '      prefix$ (one character at the start)
  1784.   '      entry$  (text to add)
  1785.   '
  1786.   IF EXIST(log$)
  1787.     OPEN "A",#54,log$,4096
  1788.   ELSE
  1789.     OPEN "O",#54,log$,4096
  1790.   ENDIF
  1791.   '
  1792.   PRINT #54,LEFT$(prefix$,1);" ";
  1793.   @dateconv(DATE$)
  1794.   PRINT #54,pd.date$;" ";
  1795.   PRINT #54,TIME$;"  ";
  1796.   IF LEN(entry$)<=58
  1797.     PRINT #54,entry$
  1798.   ELSE
  1799.     aa%=RINSTR(entry$," ",58)
  1800.     IF aa%=0
  1801.       PRINT #54,LEFT$(entry$,58)
  1802.       PRINT #54,SPACE$(24);"..";RIGHT$(entry$,LEN(entry$)-58)
  1803.     ELSE
  1804.       PRINT #54,LEFT$(entry$,aa%)
  1805.       PRINT #54,SPACE$(24);"..";RIGHT$(entry$,LEN(entry$)-aa%)
  1806.     ENDIF
  1807.   ENDIF
  1808.   CLOSE #54
  1809. RETURN
  1810. '
  1811. '
  1812. PROCEDURE dateconv(pddt$)
  1813.   '
  1814.   ' converts date to Fido style DD Mmm YY
  1815.   ' string to use in program is pd.date$
  1816.   ' pd.date$ is always of the form DD Mmm YY (ie 9 chars long)
  1817.   '
  1818.   LOCAL pd.temp$,pd.date1$,pd.date2$,pd.date3$,pd.month%,pd.month$
  1819.   '
  1820.   pd.date1$=LEFT$(pddt$,2)
  1821.   pd.date2$=MID$(pddt$,4,2)
  1822.   pd.date3$=RIGHT$(pddt$,2)
  1823.   pd.month%=VAL(pddt$)
  1824.   '
  1825.   SELECT pd.month%
  1826.     '
  1827.   CASE 1
  1828.     pd.month$="Jan"
  1829.   CASE 2
  1830.     pd.month$="Feb"
  1831.   CASE 3
  1832.     pd.month$="Mar"
  1833.   CASE 4
  1834.     pd.month$="Apr"
  1835.   CASE 5
  1836.     pd.month$="May"
  1837.   CASE 6
  1838.     pd.month$="Jun"
  1839.   CASE 7
  1840.     pd.month$="Jul"
  1841.   CASE 8
  1842.     pd.month$="Aug"
  1843.   CASE 9
  1844.     pd.month$="Sep"
  1845.   CASE 10
  1846.     pd.month$="Oct"
  1847.   CASE 11
  1848.     pd.month$="Nov"
  1849.   CASE 12
  1850.     pd.month$="Dec"
  1851.   DEFAULT
  1852.     pd.month$="???"
  1853.   ENDSELECT
  1854.   pd.date$=pd.date2$+" "+pd.month$+" "+pd.date3$
  1855.   '
  1856. RETURN
  1857. '
  1858. '
  1859. PROCEDURE tchk
  1860.   timenow%=CINT(TIMER/200)
  1861.   ctime%=(timenow%-timeon%)
  1862.   ctime%=CINT(ctime%/60)
  1863.   rtime%=tpc%-ctime%
  1864.   '
  1865.   IF rtime%<=0
  1866.     @msend(ansi$(1)+CHR$(7)+cr$+cr$+"Sorry, time limit exceeded!!"+CHR$(7))
  1867.     DELAY 2
  1868.     car%=2
  1869.     timewarn1!=TRUE
  1870.     timewarn2!=TRUE
  1871.     timewarn5!=TRUE
  1872.   ENDIF
  1873.   IF rtime%>5
  1874.     timewarn1!=FALSE
  1875.     timewarn2!=FALSE
  1876.     timewarn5!=FALSE
  1877.   ENDIF
  1878.   IF rtime%<=1 AND timewarn1!=FALSE
  1879.     @msend(ansi$(1)+cr$+cr$+"WARNING: 1 Minute or Less Remaining This Call!"+cr$)
  1880.     DELAY 2
  1881.     timewarn1!=TRUE
  1882.     timewarn2!=TRUE
  1883.     timewarn5!=TRUE
  1884.   ENDIF
  1885.   IF rtime%<=2 AND timewarn2!=FALSE
  1886.     @msend(ansi$(1)+cr$+cr$+"WARNING: 2 Minutes or Less Remaining This Call!"+cr$)
  1887.     DELAY 1
  1888.     timewarn2!=TRUE
  1889.     timewarn5!=TRUE
  1890.   ENDIF
  1891.   IF rtime%<=5 AND timewarn5!=FALSE
  1892.     @msend(ansi$(1)+cr$+cr$+"WARNING: 5 Minutes or Less Remaining This Call!"+cr$)
  1893.     DELAY 1
  1894.     timewarn5!=TRUE
  1895.   ENDIF
  1896.   '
  1897. RETURN
  1898. '
  1899. '
  1900. PROCEDURE timeconv
  1901.   ' Pd.time$ is always 'HH:MM:SS xM' (ie 11 chars long) a leading 0 if needed
  1902.   '
  1903.   LOCAL t.t%
  1904.   '
  1905.   time1$=TIME$
  1906.   t.t%=VAL(LEFT$(time1$,2))
  1907.   IF t.t%>11
  1908.     a$=" PM"
  1909.   ELSE
  1910.     a$=" AM"
  1911.   ENDIF
  1912.   '
  1913.   IF t.t%=0
  1914.     t.t%=12
  1915.     time1$=STR$(t.t%)+RIGHT$(time1$,6)
  1916.   ELSE IF t.t%<10
  1917.     time1$="0"+STR$(t.t%)+RIGHT$(time1$,6)
  1918.   ELSE IF t.t%>21
  1919.     t.t%=t.t%-12
  1920.     time1$=STR$(t.t%)+RIGHT$(time1$,6)
  1921.   ELSE IF t.t%>12
  1922.     t.t%=t.t%-12
  1923.     time1$="0"+STR$(t.t%)+RIGHT$(time1$,6)
  1924.   ENDIF
  1925.   pd.time$=time1$+a$
  1926.   '
  1927. RETURN
  1928. '
  1929. '
  1930. PROCEDURE checkansi
  1931.   '
  1932.   @msend(cr$+cr$+ansi$(3)+"Do you want ANSI (Y/n)? ")
  1933.   @mget(3,1,1,1)
  1934.   IF car%>0
  1935.     GOTO checkansiexit
  1936.   ENDIF
  1937.   '
  1938.   IF in$="YES"
  1939.     ansi!=TRUE
  1940.   ELSE
  1941.     ansi!=FALSE
  1942.   ENDIF
  1943.   checkansiexit:
  1944.   '
  1945. RETURN
  1946. '
  1947. '
  1948. PROCEDURE setansi
  1949.   '
  1950.   IF ansi!=TRUE
  1951.     ansi$(1)=esc$+"[31m"
  1952.     ansi$(2)=esc$+"[32m"
  1953.     ansi$(3)=esc$+"[33m"
  1954.     ansi$(4)=esc$+"[34m"
  1955.     ansi$(5)=esc$+"[35m"
  1956.     ansi$(6)=esc$+"[36m"
  1957.     ansi$(7)=esc$+"[37m"
  1958.     ansi$(8)=esc$+"[1m"
  1959.     ansi$(9)=esc$+"[3m"
  1960.     ansi$(10)=esc$+"[4m"
  1961.   ELSE
  1962.     FOR kk%=1 TO 10
  1963.       ansi$(kk%)=""
  1964.     NEXT kk%
  1965.   ENDIF
  1966.   ' regardless of setting, this is needed for safety!
  1967.   ansi$(0)=esc$+"[0;37;40m"
  1968.   @msend(ansi$(0))
  1969. RETURN
  1970. '
  1971. '
  1972. PROCEDURE beepthree
  1973.   @msend(CHR$(7))
  1974.   PAUSE 5
  1975.   @msend(CHR$(7))
  1976.   PAUSE 5
  1977.   @msend(CHR$(7))
  1978.   PAUSE 5
  1979. RETURN
  1980. '
  1981. '
  1982. PROCEDURE lowercase(ucase$)
  1983.   '
  1984.   LOCAL ad%,ad2%
  1985.   ad%=0
  1986.   ad2%=0
  1987.   '
  1988.   ucase$=UPPER$(ucase$)
  1989.   lcase$=UPPER$(ucase$)
  1990.   IF LEN(ucase$)<1 OR LEN(ucase$)>56
  1991.     GOTO noworkjump
  1992.   ENDIF
  1993.   '
  1994.   ad%=AllocMem(60,0)
  1995.   IF ad%=0
  1996.     GOTO noworkjump
  1997.   ENDIF
  1998.   ad2%=AllocMem(60,0)
  1999.   IF ad2%=0
  2000.     GOTO noworkjump
  2001.   ENDIF
  2002.   '
  2003.   FOR k%=0 TO 59
  2004.     POKE ad%+k%,0
  2005.     POKE ad2%+k%,0
  2006.   NEXT k%
  2007.   '
  2008.   FOR k%=1 TO LEN(ucase$)
  2009.     POKE ad%+(k%-1),ASC(MID$(ucase$,k%,1))
  2010.     POKE ad2%+(k%-1),ASC(MID$(ucase$,k%,1))
  2011.   NEXT k%
  2012.   '
  2013.   FOR k%=1 TO 60
  2014.     ' start at second char. Leave first one alone!
  2015.     temp|=PEEK(ad%+k%)
  2016.     IF temp|>64 AND temp|<91
  2017.       IF PEEK(ad%+k%-1)>64 AND PEEK(ad%+k%-1)<91
  2018.         temp|=BSET(temp|,5)
  2019.         POKE ad2%+k%,temp|
  2020.       ENDIF
  2021.     ENDIF
  2022.   NEXT k%
  2023.   '
  2024.   lcase$=CHAR{ad2%}
  2025.   lcase$=TRIM$(lcase$)
  2026.   '
  2027.   noworkjump:
  2028.   IF ad%>0
  2029.     ~FreeMem(ad%,60)
  2030.   ENDIF
  2031.   IF ad2%>0
  2032.     ~FreeMem(ad2%,60)
  2033.   ENDIF
  2034.   '
  2035. RETURN
  2036. '
  2037. '
  2038. PROCEDURE spaceout(thing$,col%)
  2039.   '
  2040.   ' [Needs the string to format, and the column width it's going to]
  2041.   ' [Returns spc% - the number of spaces required - 0 if field overflow]
  2042.   '
  2043.   IF LEN(thing$)>col%
  2044.     spc%=0
  2045.   ELSE
  2046.     spc%=(col%-LEN(thing$))
  2047.   ENDIF
  2048.   '
  2049. RETURN
  2050. '
  2051. '
  2052. PROCEDURE centre(some$)
  2053.   '
  2054.   ' [takes a string - MUST BE less than 76 chars]
  2055.   ' [returns centred$]
  2056.   '
  2057.   IF LEN(some$)<76
  2058.     centred$=SPACE$(38-(LEN(some$)/2))+some$
  2059.   ELSE
  2060.     centred$=some$
  2061.   ENDIF
  2062.   '
  2063. RETURN
  2064. '
  2065. '
  2066. PROCEDURE chooseproto
  2067.   '
  2068.   protocol%=0
  2069.   @msend(cr$+cr$+ansi$(0)+ansi$(5)+"Choose file transfer protocol:"+cr$)
  2070.   @msend(cr$+"     "+ansi$(2)+"[0]"+ansi$(1)+"  Zmodem (default)")
  2071.   @msend(cr$+"     "+ansi$(2)+"[1]"+ansi$(1)+" SZmodem SUPER Zmodem")
  2072.   @msend(cr$+"     "+ansi$(2)+"[2]"+ansi$(1)+"  Ymodem (batch)")
  2073.   '
  2074.   @msend(cr$+cr$+ansi$(6)+"Enter your choice, return for default: "+ansi$(3))
  2075.   @mget(0,1,0,1)
  2076.   IF car%>0
  2077.     GOTO chooseprotoexit
  2078.   ENDIF
  2079.   '
  2080.   aa%=VAL(in$)
  2081.   '
  2082.   IF aa%=1
  2083.     protocol%=1
  2084.   ELSE IF aa%=2
  2085.     protocol%=2
  2086.   ELSE
  2087.     protocol%=0
  2088.   ENDIF
  2089.   '
  2090.   '
  2091.   chooseprotoexit:
  2092.   '
  2093. RETURN
  2094. '
  2095. '
  2096. PROCEDURE banner
  2097.   '
  2098.   @msend(CHR$(12)+ansi$(0))
  2099.   @msend(ansi$(6)+"  ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"+cr$)
  2100.   @msend(ansi$(6)+"  º "+ansi$(5)+"  ÜÜÜÜÜÜÜ  "+ansi$(1)+"Ü      "+ansi$(2)+"Ü    Ü  "+ansi$(4)+"ÜÜÜÜÜÜÜ  "+ansi$(7)+"ÜÜÜ     "+ansi$(6)+"ÜÜÜÜÜÜÜ  "+ansi$(3)+"ÜÜÜÜÜÜÜ  "+ansi$(5)+"ÜÜÜÜÜ    "+ansi$(6)+"º "+ansi$(4)+"°°"+cr$)
  2101.   @msend(ansi$(6)+"  º "+ansi$(5)+"  Û     Û  "+ansi$(1)+"Û      "+ansi$(2)+"Û    Û  "+ansi$(4)+"   Û     "+ansi$(7)+"Û  ßÜ   "+ansi$(6)+"Û     Û  "+ansi$(3)+"Û     Û  "+ansi$(5)+"Û    ßÜ  "+ansi$(6)+"º "+ansi$(4)+"°°"+cr$)
  2102.   @msend(ansi$(6)+"  º "+ansi$(5)+"  Û     Û  "+ansi$(1)+"Û      "+ansi$(2)+"Û    Û  "+ansi$(4)+"   Û     "+ansi$(7)+"Û    Û  "+ansi$(6)+"Û     Û  "+ansi$(3)+"Û     Û  "+ansi$(5)+"Û    Üß  "+ansi$(6)+"º "+ansi$(4)+"°°"+cr$)
  2103.   @msend(ansi$(6)+"  º "+ansi$(5)+"  Ûßßßßßß  "+ansi$(1)+"Û      "+ansi$(2)+"Û    Û  "+ansi$(4)+"   Û     "+ansi$(7)+"Û    Û  "+ansi$(6)+"Û     Û  "+ansi$(3)+"Û     Û  "+ansi$(5)+"ÛßßßßÜ   "+ansi$(6)+"º "+ansi$(4)+"°°"+cr$)
  2104.   @msend(ansi$(6)+"  º "+ansi$(5)+"  Û        "+ansi$(1)+"Û      "+ansi$(2)+"Û    Û  "+ansi$(4)+"   Û     "+ansi$(7)+"Û  Üß   "+ansi$(6)+"Û     Û  "+ansi$(3)+"Û     Û  "+ansi$(5)+"Û    ßÜ  "+ansi$(6)+"º "+ansi$(4)+"°°"+cr$)
  2105.   @msend(ansi$(6)+"  º "+ansi$(5)+"  ß        "+ansi$(1)+"ßßßßß  "+ansi$(2)+"ßßßßßß  "+ansi$(4)+"   ß     "+ansi$(7)+"ßßß     "+ansi$(6)+"ßßßßßßß  "+ansi$(3)+"ßßßßßßß  "+ansi$(5)+"ß     ß  "+ansi$(6)+"º "+ansi$(4)+"°°"+cr$)
  2106.   @msend(ansi$(6)+"  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "+ansi$(4)+"°°"+cr$)
  2107.   @msend(ansi$(4)+"    °°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°"+cr$+cr$+cr$)
  2108.   '
  2109.   IF ansi!
  2110.     @msend(esc$+"[0;31m  "+esc$+"[43mÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"+esc$+"[0m"+cr$)
  2111.     @msend(esc$+"[0;31m  "+esc$+"[43m³  "+esc$+"[35m                The Online Point Pickup Program                      "+esc$+"[31m³"+esc$+"[0m"+cr$)
  2112.     @msend(esc$+"[0;31m  "+esc$+"[43m³  "+esc$+"[34m   Copyright (c) 1992 by Peter Deane - Inquestor BBS, Australia      "+esc$+"[31m³"+esc$+"[0m"+cr$)
  2113.     @msend(esc$+"[0;31m  "+esc$+"[43mÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"+esc$+"[0m"+cr$)
  2114.   ELSE
  2115.     @msend("  ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"+cr$)
  2116.     @msend("  ³                 The Online Point Pickup Program                       ³"+cr$)
  2117.     @msend("  ³     Copyright (c) 1992 by Peter Deane - Inquestor BBS, Australia      ³"+cr$)
  2118.     @msend("  ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"+cr$)
  2119.   ENDIF
  2120.   @killkeys
  2121.   @press
  2122.   '
  2123. RETURN
  2124. '
  2125. '
  2126. PROCEDURE convfqfa(enterednode$)
  2127.   '
  2128.   convnode$=enterednode$+CHR$(0)
  2129.   convprob!=FALSE
  2130.   addr%=0
  2131.   defaddr%=0
  2132.   '
  2133.   nodelistlib$="traplist.library"+CHR$(0)
  2134.   nodelistbase%=OpenLibrary(V:nodelistlib$,0)
  2135.   '
  2136.   IF nodelistbase%=0
  2137.     convprob!=TRUE
  2138.     @msend(cr$+"ERROR: traplist.library couldn't be opened."+cr$)
  2139.     @msend("Using 0:0/0.0 as node number."+cr$)
  2140.     zone&=0
  2141.     net&=0
  2142.     node&=0
  2143.     point&=0
  2144.   ELSE
  2145.     '
  2146.     addr%=AllocMem(8,65536)
  2147.     defaddr%=AllocMem(8,65536)
  2148.     '
  2149.     DPOKE defaddr%+0,0
  2150.     DPOKE defaddr%+2,0
  2151.     DPOKE defaddr%+4,0
  2152.     DPOKE defaddr%+6,0
  2153.     '
  2154.     ' parse the input into addr% via the library.
  2155.     '
  2156.     nlparseaddr(addr%,V:convnode$,defaddr%)
  2157.     '
  2158.     IF m68%(0)=0
  2159.       zone&=DPEEK(addr%+0)
  2160.       net&=DPEEK(addr%+2)
  2161.       node&=DPEEK(addr%+4)
  2162.       point&=DPEEK(addr%+6)
  2163.     ELSE
  2164.       @msend(cr$+"ERROR: Invalid host node # in config."+cr$)
  2165.       @msend("Using 0:0/0.0 as node number."+cr$+cr$)
  2166.       convprob!=TRUE
  2167.       zone&=0
  2168.       net&=0
  2169.       node&=0
  2170.       point&=0
  2171.     ENDIF
  2172.   ENDIF
  2173.   '
  2174.   IF addr%
  2175.     ~FreeMem(addr%,8)
  2176.   ENDIF
  2177.   '
  2178.   IF defaddr%
  2179.     ~FreeMem(defaddr%,8)
  2180.   ENDIF
  2181.   '
  2182.   IF nodelistbase%
  2183.     ~CloseLibrary(nodelistbase%)
  2184.   ENDIF
  2185.   '
  2186. RETURN
  2187. '
  2188. '
  2189. PROCEDURE nlparseaddr(addr%,str%,default%)
  2190.   m68%(8)=addr%
  2191.   m68%(9)=str%
  2192.   m68%(10)=default%
  2193.   m68%(14)=nodelistbase%
  2194.   RCALL nodelistbase%-156,m68%()
  2195. RETURN
  2196. '
  2197. '
  2198. PROCEDURE find.config
  2199.   '
  2200.   IF EXIST(path$+"PlutDoor.cfg")
  2201.     config$=path$+"PlutDoor.cfg"
  2202.   ELSE
  2203.     config$="XXX"
  2204.   ENDIF
  2205.   '
  2206.   ' Defaults
  2207.   '
  2208.   here$="3:0/0.0"
  2209.   '
  2210.   winw$="640"
  2211.   winh$="200"
  2212.   actwin!=TRUE
  2213.   sysopname$="Sysop"
  2214.   bbsname$="This BBS"
  2215.   lockedmodem!=FALSE
  2216.   logfile$=path$+"PlutDoor.log"
  2217.   maxbaud$="2400"
  2218.   outbound$="MAIL:Outbound/"
  2219.   inbound$="MAIL:Inbound/"
  2220.   textdir$=path$+"Texts/"
  2221.   xferdir$=path$+"Xfers/"
  2222.   userdir$=path$+"Users/"
  2223.   device$="serial.device"
  2224.   unit%=0
  2225.   freqconfig$="Mail:FFRS.cfg"
  2226.   freqhandler$="FFRS %C %i %o %B %n %s"
  2227.   '
  2228.   '
  2229.   IF config$<>"XXX"
  2230.     '
  2231.     OPEN "I",#2,config$,128
  2232.     configerr!=FALSE
  2233.     DO
  2234.       '
  2235.       LINE INPUT #2,xx$
  2236.       '
  2237.       xx$=TRIM$(xx$)
  2238.       xxu$=UPPER$(xx$)
  2239.       '
  2240.       IF xx$="" OR LEFT$(xx$,1)=";"
  2241.         ' Do nothing
  2242.       ELSE IF LEFT$(xxu$,14)="ACTIVATEWINDOW"
  2243.         actwin!=TRUE
  2244.       ELSE IF LEFT$(xxu$,16)="NOACTIVATEWINDOW"
  2245.         actwin!=FALSE
  2246.       ELSE IF LEFT$(xxu$,4)="HERE"
  2247.         xx$=RIGHT$(xx$,LEN(xx$)-4)
  2248.         xx$=TRIM$(xx$)
  2249.         here$=xx$
  2250.       ELSE IF LEFT$(xxu$,6)="SWIDTH"
  2251.         xx$=MID$(xx$,7,4)
  2252.         xx$=TRIM$(xx$)
  2253.         winw$=xx$
  2254.       ELSE IF LEFT$(xxu$,7)="SHEIGHT"
  2255.         xx$=MID$(xx$,8,4)
  2256.         xx$=TRIM$(xx$)
  2257.         winh$=xx$
  2258.       ELSE IF LEFT$(xxu$,5)="SYSOP"
  2259.         xx$=RIGHT$(xx$,LEN(xx$)-5)
  2260.         xx$=TRIM$(xx$)
  2261.         sysopname$=xx$
  2262.       ELSE IF LEFT$(xxu$,7)="BBSNAME"
  2263.         xx$=RIGHT$(xx$,LEN(xx$)-7)
  2264.         xx$=TRIM$(xx$)
  2265.         bbsname$=xx$
  2266.       ELSE IF LEFT$(xxu$,7)="INBOUND"
  2267.         xx$=RIGHT$(xx$,LEN(xx$)-7)
  2268.         xx$=TRIM$(xx$)
  2269.         inbound$=xx$
  2270.         IF RIGHT$(inbound$,1)<>"/" AND RIGHT$(inbound$,1)<>":"
  2271.           inbound$=inbound$+"/"
  2272.         ENDIF
  2273.       ELSE IF LEFT$(xxu$,8)="OUTBOUND"
  2274.         xx$=RIGHT$(xx$,LEN(xx$)-8)
  2275.         xx$=TRIM$(xx$)
  2276.         outbound$=xx$
  2277.         IF RIGHT$(outbound$,1)<>"/" AND RIGHT$(outbound$,1)<>":"
  2278.           outbound$=outbound$+"/"
  2279.         ENDIF
  2280.       ELSE IF LEFT$(xxu$,9)="TEXTFILES"
  2281.         xx$=RIGHT$(xx$,LEN(xx$)-9)
  2282.         xx$=TRIM$(xx$)
  2283.         textdir$=xx$
  2284.         IF RIGHT$(textdir$,1)<>"/" AND RIGHT$(textdir$,1)<>":"
  2285.           textdir$=textdir$+"/"
  2286.         ENDIF
  2287.       ELSE IF LEFT$(xxu$,5)="USERS"
  2288.         xx$=RIGHT$(xx$,LEN(xx$)-5)
  2289.         xx$=TRIM$(xx$)
  2290.         userdir$=xx$
  2291.         IF RIGHT$(userdir$,1)<>"/" AND RIGHT$(userdir$,1)<>":"
  2292.           userdir$=userdir$+"/"
  2293.         ENDIF
  2294.       ELSE IF LEFT$(xxu$,5)="XFERS"
  2295.         xx$=RIGHT$(xx$,LEN(xx$)-5)
  2296.         xx$=TRIM$(xx$)
  2297.         xferdir$=xx$
  2298.         IF RIGHT$(xferdir$,1)<>"/" AND RIGHT$(xferdir$,1)<>":"
  2299.           xferdir$=xferdir$+"/"
  2300.         ENDIF
  2301.       ELSE IF LEFT$(xxu$,6)="DEVICE"
  2302.         xx$=RIGHT$(xx$,LEN(xx$)-6)
  2303.         xx$=TRIM$(xx$)
  2304.         device$=xx$
  2305.       ELSE IF LEFT$(xxu$,4)="UNIT"
  2306.         xx$=RIGHT$(xx$,LEN(xx$)-4)
  2307.         xx$=TRIM$(xx$)
  2308.         unit%=VAL(xx$)
  2309.       ELSE IF LEFT$(xxu$,7)="LOGFILE"
  2310.         xx$=RIGHT$(xx$,LEN(xx$)-7)
  2311.         xx$=TRIM$(xx$)
  2312.         logfile$=xx$
  2313.       ELSE IF LEFT$(xxu$,10)="FREQCONFIG"
  2314.         xx$=RIGHT$(xx$,LEN(xx$)-10)
  2315.         freqconfig$=TRIM$(xx$)
  2316.       ELSE IF LEFT$(xxu$,11)="FREQHANDLER"
  2317.         xx$=RIGHT$(xx$,LEN(xx$)-11)
  2318.         freqhandler$=TRIM$(xx$)
  2319.         '
  2320.         '
  2321.       ENDIF
  2322.       '
  2323.     LOOP UNTIL EOF(#2)
  2324.     CLOSE #2
  2325.     '
  2326.     '
  2327.   ENDIF
  2328.   '
  2329. RETURN
  2330. '
  2331. '
  2332. PROCEDURE find.user
  2333.   '
  2334.   OPEN "I",#2,userdir$+uname$,4096
  2335.   WHILE NOT EOF(#2)
  2336.     LINE INPUT #2,xx$
  2337.     xx$=TRIM$(xx$)
  2338.     '
  2339.     IF xx$="" OR LEFT$(xx$,1)=";"
  2340.       ' Do nothing
  2341.     ELSE IF LEFT$(xx$,4)="AKA0"
  2342.       xx$=RIGHT$(xx$,LEN(xx$)-4)
  2343.       xx$=TRIM$(xx$)
  2344.       aka$(0)=xx$
  2345.     ELSE IF LEFT$(xx$,4)="AKA1"
  2346.       xx$=RIGHT$(xx$,LEN(xx$)-4)
  2347.       xx$=TRIM$(xx$)
  2348.       aka$(1)=xx$
  2349.     ELSE IF LEFT$(xx$,4)="AKA2"
  2350.       xx$=RIGHT$(xx$,LEN(xx$)-4)
  2351.       xx$=TRIM$(xx$)
  2352.       aka$(2)=xx$
  2353.     ELSE IF LEFT$(xx$,4)="AKA3"
  2354.       xx$=RIGHT$(xx$,LEN(xx$)-4)
  2355.       xx$=TRIM$(xx$)
  2356.       aka$(3)=xx$
  2357.     ELSE IF LEFT$(xx$,4)="AKA4"
  2358.       xx$=RIGHT$(xx$,LEN(xx$)-4)
  2359.       xx$=TRIM$(xx$)
  2360.       aka$(4)=xx$
  2361.     ELSE IF LEFT$(xx$,4)="AKA5"
  2362.       xx$=RIGHT$(xx$,LEN(xx$)-4)
  2363.       xx$=TRIM$(xx$)
  2364.       aka$(5)=xx$
  2365.     ELSE IF LEFT$(xx$,4)="AKA6"
  2366.       xx$=RIGHT$(xx$,LEN(xx$)-4)
  2367.       xx$=TRIM$(xx$)
  2368.       aka$(6)=xx$
  2369.     ELSE IF LEFT$(xx$,4)="AKA7"
  2370.       xx$=RIGHT$(xx$,LEN(xx$)-4)
  2371.       xx$=TRIM$(xx$)
  2372.       aka$(7)=xx$
  2373.     ELSE IF LEFT$(xx$,4)="AKA8"
  2374.       xx$=RIGHT$(xx$,LEN(xx$)-4)
  2375.       xx$=TRIM$(xx$)
  2376.       aka$(8)=xx$
  2377.     ELSE IF LEFT$(xx$,4)="AKA9"
  2378.       xx$=RIGHT$(xx$,LEN(xx$)-4)
  2379.       xx$=TRIM$(xx$)
  2380.       aka$(9)=xx$
  2381.     ELSE IF LEFT$(xx$,8)="PASSWORD"
  2382.       xx$=RIGHT$(xx$,LEN(xx$)-8)
  2383.       xx$=TRIM$(xx$)
  2384.       password$=xx$
  2385.       password$=UPPER$(password$)
  2386.     ELSE IF LEFT$(xx$,10)="FREQCONFIG"
  2387.       xx$=RIGHT$(xx$,LEN(xx$)-10)
  2388.       freqconfig$=TRIM$(xx$)
  2389.       '
  2390.     ENDIF
  2391.   WEND
  2392.   CLOSE #2
  2393.   '
  2394.   c%=0
  2395.   WHILE aka$(0)=""
  2396.     INC c%
  2397.     IF aka$(0)=""
  2398.       DELETE aka$(0)
  2399.     ENDIF
  2400.     EXIT IF c%>=9
  2401.   WEND
  2402.   '
  2403.   FOR k%=0 TO 9
  2404.     @convfqfa(aka$(k%))
  2405.     IF (convprob!=TRUE) OR (zone&+net&+node&+point&=0)
  2406.       aka$(k%)=""
  2407.     ELSE
  2408.       aka$(k%)=STR$(zone&)+":"+STR$(net&)+"/"+STR$(node&)+"."+STR$(point&)
  2409.     ENDIF
  2410.     aka%(k%,1)=zone&
  2411.     aka%(k%,2)=net&
  2412.     aka%(k%,3)=node&
  2413.     aka%(k%,4)=point&
  2414.   NEXT k%
  2415.   '
  2416. RETURN
  2417. '
  2418. '
  2419. PROCEDURE embed_convert(xx.arg$)
  2420.   LOCAL c%,out$
  2421.   '
  2422.   c%=0
  2423.   out$=""
  2424.   '
  2425.   DO
  2426.     IF xx.arg$=""
  2427.       embed$=xx.arg$
  2428.     ENDIF
  2429.     EXIT IF xx.arg$=""
  2430.     '
  2431.     INC c%
  2432.     xx$=MID$(xx.arg$,c%,1)
  2433.     '
  2434.     IF xx$<>"%"
  2435.       out$=out$+xx$
  2436.     ELSE
  2437.       INC c%
  2438.       xy$=MID$(xx.arg$,c%,1)
  2439.       '
  2440.       SELECT xy$
  2441.       CASE "%"
  2442.         out$=out$+"%"
  2443.       CASE "Z"
  2444.         out$=out$+STR$(aka%(0,1))
  2445.       CASE "N"
  2446.         out$=out$+STR$(aka%(0,2))
  2447.       CASE "F"
  2448.         out$=out$+STR$(aka%(0,3))
  2449.       CASE "P"
  2450.         out$=out$+STR$(aka%(0,4))
  2451.       CASE "n"
  2452.         out$=out$+aka$(0)
  2453.       CASE "S"
  2454.         out$=out$+UPPER$(uname$)
  2455.       CASE "s"
  2456.         out$=out$+uname$
  2457.       CASE "I"
  2458.         out$=out$+inbound$
  2459.       CASE "O"
  2460.         out$=out$+outbound$
  2461.       CASE "b"
  2462.         out$=out$+baud$
  2463.       CASE "B"
  2464.         out$=out$+realbaud$
  2465.       CASE "l"
  2466.         out$=out$+logfile$
  2467.       CASE "A"
  2468.         xx$=""
  2469.         FOR kkq%=1 TO 10
  2470.           IF aka$(kkq%)<>""
  2471.             xx$=xx$+aka$(kkq%)+" "
  2472.           ENDIF
  2473.         NEXT kkq%
  2474.         out$=out$+TRIM$(xx$)
  2475.       CASE "C"
  2476.         out$=out$+freqconfig$
  2477.       CASE "i"
  2478.         out$=out$+CHR$(34)+"Ram:PlutDoor.REQ"+CHR$(34)
  2479.       CASE "o"
  2480.         out$=out$+CHR$(34)+userdir$+uname$+".RLO"+CHR$(34)
  2481.         '
  2482.       ENDSELECT
  2483.     ENDIF
  2484.     EXIT IF c%>=LEN(xx.arg$)
  2485.   LOOP
  2486.   embed$=out$
  2487.   out$=""
  2488. RETURN
  2489.